Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/swagg_m.zip/MISC.SWG

Text File | 1993-05-28 | 119KB | 1 lines

SWAGOLX.EXE (c) 1993 GDSOFT  ALL RIGHTS RESERVED 00017         ANYTHING NOT OTHERWISE CLASSIFIED                                 1      05-28-9313:51ALL                      SWAG SUPPORT TEAM        BOOKISBN.PAS             IMPORT              14          {π For you Programming librarians: the following Turbo Pascal Programπ will verify any ISBN (International Standard Book Number).π}π(*******************************************************************)π Program VerifyISBN;    { Verify any ISBN number. Turbo Pascal      }π                        { 1992, 1993 Greg Vigneault                 }ππ Var    ISBNstr                     : String[16];π        loopc, ISBNlen, M, chksm    : Byte;π beginπ    WriteLn; WriteLn( 'ISBN Verification v0.1, Greg Vigneault',#10);ππ    if ( ParamCount <> 1 ) then begin   { we want just 1 input parm }π        WriteLn( 'Syntax: ISBN <ISBN#>',#7 );π        Halt(1);π    end;π    ISBNstr := ParamStr(1);                     { get ISBN# String  }π    Write( 'Checking ISBN# ', ISBNstr );π    { eliminate any non-digit Characters from the ISBN String...    }π    ISBNlen := 0;π    For loopc := 1 to orD( ISBNstr[0] ) doπ        if ( ISBNstr[ loopc ] in ['0'..'9'] ) then beginπ            inC( ISBNlen );π            ISBNstr[ ISBNlen ] := ISBNstr[ loopc ];π        end;π    { an 'X' at the end of the ISBN affects the result              }π    if ( ISBNstr[ orD( ISBNstr[0] ) ] in ['X','x'] )π        then M := 10π        else M := orD( ISBNstr[ ISBNlen ] ) - 48;π    ISBNstr[0] := CHR( ISBNlen );           { new ISBN str length   }π    chksm := 0;π    For loopc := 1 to ISBNlen-1 doπ        inC( chksm, ( orD( ISBNstr[ loopc ] ) - 48 ) * loopc );π    Write( ' <--- ' );π    if ( ( chksm MOD 11 ) = M )π        then WriteLn( 'Okay' )π        else WriteLn( 'ERRor!',#7 );π end {VerifyISBN}.π(********************************************************************)π                        2      05-28-9313:51ALL                      SWAG SUPPORT TEAM        CPAS-OBJ.PAS             IMPORT              5           REYNIR STEFANSSONππ> Does anyone know of any way to convert a .TPU to a .BIN File toπ> use BIN2OBJ.EXE and then load it as an external? Any helpπ> appreciated...ππIt's a bit round-the-block, but you might get some exercise out of it,πassuming you have the source code:ππ1) Smash the source into C With a code converter.ππ2) Declare the Procedures as `void far PASCAL' and the Functions asπ   `appropriate_Type far PASCAL'.ππ3) Compile it With Turbo C or similar.ππ                                                3      05-28-9313:51ALL                      SWAG SUPPORT TEAM        DBASE4.PRG               IMPORT              39          {πHello every one... Guys and gals is there any such a thing that you canπuse turbp pascal 6 with Dbase IV.. what I heard is I can.πif yes tell me how you export or whatever to use two of thewmπtogether,,,ππYes there is! I have been using it for some time now in dBase as I useπan XT and dBase's editor is too slow when the program has quite a fewπlines (some are 5,000) and the system just kind of dies. When I use TP'sπIDE the editor is FAST!!!! So after reading the books I designed aπprogram in order to use TP as using it in the TEDIT CONFIG.DB commandπwouldn't work as it needed more memory (I only have 640k).π}πππIn dBase's setup program, under the FILES MENU enter in eitherπPRGAPPLIC (overrides Application Control in the ASSIST menu only!) orπ Entry  - C:\DBASEIV\EDIT2.PRGπ Exit   - emptyπ Layout - emptyπPRGCC (allows you to use OPEN CUSTOM UTILIY option under Catalog Menu).π Entry  - emptyπ Exit   - emptyπ Layout - C:\DBASEIV\EDIT2.PRGππI am currently using PRGAPPLIC as I do most of my work in the ControlπCenter anyhow and don't need the Application Generator. Note - PRGCCπwill not pull in a PRG file unless you change the source code to ask forπone.ππHere is the dBase program that calls Turbo Pascal:ππ* <T>Program ----> EDIT2.PRGπ* <D>Language ---> dBase IV 1.5π* <P>Author -----> P.A.T. Systems° C.1993π* <T>Creation date -> 07/22/1992π* <L>Last update ---> 01/06/1993ππ* <G>From-> Control Centerπ* <N>To---> Noneπ* <T>Subs-> Noneππ* This program invokes an External Editor such as Turbo Pascal 6.0'sπ* (TP) Desktop Editor by using the PRGAPPLIC setup in the Config.dbπ* file. Even though it is only for Entry Programs, with some trickyπ* commands we can get it to invoke an External Editor such as TP.ππ* Although I can't do any Compiling or Help Lookup (another use for theπ* Manuals), it still is a great and FAST!!!! Editor to work with.ππ* This program will work with any editor that will accept a filenameπ* as a parameter.ππ* Example  TURBO filename.prg  (Turbo Pascal) ORπ* WP filename.prg     (Word Perfect)ππ* As I am used to TP's Editor, I wished I could use it when I wanted toπ* edit a program.  Especially a long program that when loaded intoπ* dBase's editor is extremely slow, but in TP, editing is FAST!!! Andπ* with dBase IV 1.5's NEW Open Architecture, I now have a way to do it.ππ* This program uses the RUN() function to swap out memory to disk soπ* that the editor can load in.  With the TEDIT command in the Config.dbπ* setup, there wasn't enough memory (on an XT) to load in the editor.π* So I read the manuals (Yes, I do read them occasionally!) and figuredπ* out a way to use an External Editor by utilizing the Control Center'sπ* NEW Open Architecture.ππ* First, copy this program into dBase's Startup Directory.ππ* You next have to change dBase's setup using DBSETUP at the DOS promptπ* and load in the current configuration and then on the Files Menuπ* change the option of PRGAPPLIC so that it readsπ* "C:\DBASEIV\EDIT2.PRG". Once done, save the new configuration andπ* exit to DOS.  Then enter dBase in your usual way.  Next, create orπ* edit an existing program through the Control Center's Applicationπ* Menu.  The Control Center will execute this .PRG file (it willπ* automatically compile it) and load up your Editor with the programπ* ready to edit!ππ* ***Note***π*  This program will only work through the Control Center.  If you typeπ*  "MODI COMM filename" at the DOT PROMPT, the original editor will beπ*  loaded as the Open Architecture only works with the Control Centerπ*  applications.ππ* Hope you enjoy this program!!!!ππ* Parameters passed from Control Center to Application Designerπ* Panel Name, Filename (Programming in dBase IV - Chapter 17, pg 4)ππPARAMETERS cPanelName, cFileNameππ* Clear screen and turn on cursorπ* (MODI COMM turns off cursor when loading and then turns it backπ* on when editing - Why? I don't know. When I invoked my editor, Iπ* found that the cursor had disappeared, so I included this Commandπ* and my cursor came back!)ππCLEARπSET CURSOR ONππ* Store Editor's filename and dBase .PRG Filename to variable forπ* Macro Executionππ* (You can enter your own Editor's file name here if you wish, justπ* include the FULL PATH NAME just in case, and don't forget the SPACE!)ππ* uncomment this line for PRGCC or it will load CATALOG FILEπ* STORE "" TO cFileNameπSTORE "D:\TP\TURBO " + cFileName TO cExecEditππ* Invoke RUN() function to swap out memoryππSTORE RUN("&cExecEdit",.T.) TO nRunππ* Change filename so we can erase .DBO file for proper compilingπ* If creating a new file, no need to erase .DBO fileππIF .NOT. ISBLANK(cFileName)π   STORE SUBSTR(cFileName, 1, AT(".PRG", cFileName)) + "DBO" TO ;π    cExecEditππ* Erase the .DBO fileππ   ERASE &cExecEditπENDIFππ* Return directly to Control Center instead of invoking Command EditorππRETURN TO MASTERππ* Endπ          4      05-28-9313:51ALL                      SWAG SUPPORT TEAM        FLIPLAY.PAS              IMPORT              255         {$G+}ππProgram FliPlayer;ππ{  v1.1 made by Thaco   }π{ (c) EPOS, August 1992 }πππConstπ  CLOCK_HZ              =4608;                   { Frequency of clock }π  MONItoR_HZ            =70;                     { Frequency of monitor }π  CLOCK_SCALE           =CLOCK_HZ div MONItoR_HZ;ππ  BUFFERSIZE            =$FFFE;                  { Size of the framebuffer, must be an even number }π  CDATA                 =$040;                   { Port number of timer 0 }π  CMODE                 =$043;                   { Port number of timers control Word }π  CO80                  =$3;                     { Number For standard Text mode }π  KEYBOARD              =28;                     { Numbers returned by PorT[$64] indicating what hardware caused inT 09/the - }π  MOUSE                 =60;                     { - number on PorT[$60] }π  MCGA                  =$13;                    { Number For MCGA mode }π  MCGACheck:Boolean     =True;                   { Variable For MCGA checking }π  UseXMS:Boolean        =True;                   { Variable For XMS usage }π  XMSError:Byte         =0;                      { Variable indicating the errornumber returned from the last XMS operation }ππTypeπ  EMMStructure          =Recordπ                           BytestoMoveLo,              { Low Word of Bytes to move. NB: Must be even! }π                           BytestoMoveHi,              { High Word of Bytes to move }π                           SourceHandle,               { Handle number of source (SH=0 => conventional memory) }π                           SourceoffsetLo,             { Low Word of source offset, or ofS if SH=0 }π                           SourceoffsetHi,             { High Word of source offset, or SEG if SH=0 }π                           DestinationHandle,          { Handle number of destination (DH=0 => conventional memory) }π                           DestinationoffsetLo,        { Low Word of destination offset, or ofS if DH=0 }π                           DestinationoffsetHi  :Word; { High Word of destination offset, or SEG if DH=0 }π                         end;π  HeaderType            =Array[0..128] of Byte;  { A bufferType used to read all kinds of headers }πππVarπ  Key,                                           { Variable used to check if a key has been pressed }π  OldKey                :Byte;                   { Variable used to check if a key has been pressed }π  XMSRecord             :EMMStructure;           { Variable For passing values to the XMS routine }π  InputFile             :File;                   { Variable For the incomming .FLI File }π  Header                :HeaderType;             { Buffer used to read all kinds of headers }π  Counter,                                       { General purpose counter }π  Speed                 :Integer;                { Timedifference in video tics from one frame to the next }π  FileCounter,                                   { Variable telling the point to read from in the File stored in XMS }π  FileSize,                                      { Size of the .FLI-File }π  FrameSize,                                     { Variable indicating the datasize of current frame }π  NextTime,                                      { Variable saying when it is time to move on to the next frame }π  TimeCounter,                                   { Holding the current time in video tics }π  SecondPos             :LongInt;                { Number of Bytes to skip from the start of the .FLI File when starting - }π                                                 { - from the beginning again }π  Buffer,                                        { Pointer to the Framebuffer }π  XMSEntryPoint         :Pointer;                { Entry point of the XMS routine in memory }π  SpeedString           :String[2];              { String used to parse the -sNN command }π  FileName              :String[13];             { String holding the name of the .FLI-File }π  BufferHandle,                                  { Handle number returned from the XMS routine }π  BytesRead,                                     { Variable telling the numbers of Bytes read from the .FLI File }π  FrameNumber,                                   { Number of the current frame }π  Frames,                                        { total number of frames }π  Chunks                :Word;                   { total number of chunks in a frame }πππFunction UpCaseString(Streng:String):String;π{ takes a String and convert all letters to upperCase }πVarπ  DummyString           :String;π  Counter               :Integer;πbeginπ  DummyString:='';π  For Counter:=1 to Length(Streng) doπ    DummyString:=DummyString+UpCase(Streng[Counter]);π  UpCaseString:=DummyString;πend;πππProcedure InitMode(Mode:Word); Assembler;π{ Uses BIOS interrupts to set a videomode }πAsmπ  mov  ax,Modeπ  int  10hπend;πππFunction ModeSupport(Mode:Word):Boolean; Assembler;π{ Uses BIOS interrupts to check if a videomode is supported }πLabel Exit, Last_Modes, No_Support, Supported;πVarπ  DisplayInfo           :Array[1..64] of Byte;   { Array For storing Functionality/state inFormation }πAsmπ  push esππ  mov  ah,1Bh                                    { the Functionality/state inFormation request at int 10h }π  mov  bx,0                                      { 0 = return Functionality/state inFormation }π  push ds                                        { push DS on the stack and pop it into ES so ES:DI could be used to - }π  pop  es                                        { - address DisplayInfo, as demanded of the interrupt Function }π  mov  di,offset DisplayInfoπ  int  10hππ  les  di,[dWord ptr es:di]                      { The first dWord in the buffer For state inFormation is the address - }π                                                 { - of static funtionality table }π  mov  cx,Mode                                   { Can only check For the 0h-13h modes }π  cmp  cx,13hπ  ja   No_Support                                { Return 'no support' For modes > 13h }ππ  mov  ax,1                                      { Shift the right Byte the right - }π                                                 { - times and test For the right - }π  cmp  cx,10h                                    { - bit For knowing if the       - }π  jae  Last_Modes                                { - videomode is supported       - }π                                                 { -                                }π  shl  ax,cl                                     { -                                }π  test ax,[Word ptr es:di+0]                     { -                                }π  jz   No_Support                                { -                                }π  jmp  Supported                                 { -                                }π                                                 { -                                }πLast_Modes:                                      { -                                }π  sub  cx,10h                                    { -                                }π  shl  ax,cl                                     { -                                }π  test al,[Byte ptr es:di+2]                     { -                                }π  jz   No_Support                                { -                                }ππSupported:π  mov  al,1                                      { AL=1 makes the Function return True }π  jmp  ExitππNo_Support:π  mov  al,0                                      { AL=0 makes the Function return True }ππExit:π  pop  esπend;πππFunction NoXMS:Boolean; Assembler;π{ checks out if there is a XMS driver installed, and in Case it initialize theπ  XMSEntryPoint Variable }πLabel JumpOver;πAsmπ  push esππ  mov  ax,4300h                                  { AX = 4300h => inSTALLATION CHECK }π  int  2Fh                                       { use int 2Fh Extended MEMorY SPECifICATION (XMS) }π  mov  bl,1                                      { use BL as a flag to indicate success }π  cmp  al,80h                                    { is a XMS driver installed? }π  jne  JumpOverπ  mov  ax,4310h                                  { AX = 4310h => GET DRIVER ADDRESS }π  int  2Fhπ  mov  [Word ptr XMSEntryPoint+0],BX             { initialize low Word of XMSEntryPoint }π  mov  [Word ptr XMSEntryPoint+2],ES             { initialize high Word of XMSEntryPoint }π  mov  bl,0                                      { indicate success }πJumpOver:π  mov  al,bl                                     { make the Function return True (AH=1) or False (AH=0) }ππ  pop  esπend;πππFunction XMSMaxAvail:Word; Assembler;π{ returns size of largest contiguous block of XMS in kilo (1024) Bytes }πLabel JumpOver;πAsmπ  mov  ah,08h                                    { 'Query free Extended memory' Function }π  mov  XMSError,0                                { clear error Variable }π  call [dWord ptr XMSEntryPoint]π  or   ax,ax                                     { check For error }π  jnz  JumpOverπ  mov  XMSError,bl                               { errornumber stored in BL }πJumpOver:                                        { AX=largest contiguous block of XMS }πend;πππFunction XMSGetMem(SizeInKB:Word):Word; Assembler;π{ allocates specified numbers of kilo (1024) Bytes of XMS and return a handleπ  to this XMS block }πLabel JumpOver;πAsmπ  mov  ah,09h                                    { 'Allocate Extended memory block' Function }π  mov  dx,SizeInKB                               { number of KB requested }π  mov  XMSError,0                                { clear error Variable }π  call [dWord ptr XMSEntryPoint]π  or   ax,ax                                     { check For error }π  jnz  JumpOverπ  mov  XMSError,bl                               { errornumber stored in BL }πJumpOver:π  mov  ax,dx                                     { return handle number to XMS block }πend;πππProcedure XMSFreeMem(Handle:Word); Assembler;πLabel JumpOver;πAsmπ  mov  ah,0Ah                                    { 'Free Extended memory block' Function }π  mov  dx,Handle                                 { XMS's handle number to free }π  mov  XMSError,0                                { clear error Variable }π  call [dWord ptr XMSEntryPoint]π  or   ax,ax                                     { check For error }π  jnz  JumpOverπ  mov  XMSError,bl                               { errornumber stored in BL }πJumpOver:πend;πππProcedure XMSMove(Var EMMParamBlock:EMMStructure); Assembler;πLabel JumpOver;πAsmπ  push dsπ  push esπ  push dsπ  pop  esπ  mov  ah,0Bh                                    { 'Move Extended memory block' Function }π  mov  XMSError,0                                { clear error Variable }π  lds  si,EMMParamBlock                          { DS:SI -> data to pass to the XMS routine }π  call [dWord ptr es:XMSEntryPoint]π  or   ax,ax                                     { check For error }π  jnz  JumpOverπ  mov  XMSError,bl                               { errornumber stored in BL }πJumpOver:π  pop  esπ  pop  dsπend;πππProcedure ExitDuetoXMSError;πbeginπ  InitMode(CO80);π  WriteLn('ERRor! XMS routine has reported error ',XMSError);π  XMSFreeMem(BufferHandle);π  Halt(0);πend;πππProcedure GetBlock(Var Buffer; Size:Word);π{ reads a specified numbers of data from a diskFile or XMS into a buffer }πVarπ  XMSRecord             :EMMStructure;π  NumberofBytes         :Word;πbeginπ  if UseXMS thenπ  beginπ    NumberofBytes:=Size;π    if Size MOD 2=1 thenπ      Inc(NumberofBytes);  { one must allways ask For a EQUAL number of Bytes }π    With XMSRecord doπ    beginπ      BytestoMoveLo      :=NumberofBytes;π      BytestoMoveHi      :=0;π      SourceHandle       :=BufferHandle;π      SourceoffsetLo     :=FileCounter MOD 65536;π      SourceoffsetHi     :=FileCounter div 65536;π      DestinationHandle  :=0;π      DestinationoffsetLo:=ofs(Buffer);π      DestinationoffsetHi:=Seg(Buffer);π    end;π    XMSMove(XMSRecord);π    if XMSError<>0 thenπ      ExitDuetoXMSError;π    Inc(FileCounter,Size);π  endπ  elseπ    BlockRead(InputFile,Buffer,Size);πend;πππProcedure InitClock; Assembler; {Taken from the FLILIB source}πAsmπ  mov  al,00110100b                             { put it into liNear count instead of divide by 2 }π  out  CMODE,alπ  xor  al,alπ  out  CDATA,alπ  out  CDATA,alπend;πππFunction GetClock:LongInt; Assembler; {Taken from the FLILIB source}π{ this routine returns a clock With occassional spikes where timeπ  will look like its running backwards 1/18th of a second.  The resolutionπ  of the clock is 1/(18*256) = 1/4608 second.  66 ticks of this clockπ  are supposed to be equal to a monitor 1/70 second tick.}πAsmπ  mov  ah,0                                     { get tick count from Dos and use For hi 3 Bytes }π  int  01ah                                     { lo order count in DX, hi order in CX }π  mov  ah,dlπ  mov  dl,dhπ  mov  dh,clππ  mov  al,0                                 { read lo Byte straight from timer chip }π  out  CMODE,al                                     { latch count }π  mov  al,1π  out  CMODE,al                                     { set up to read count }π  in   al,CDATA                                     { read in lo Byte (and discard) }π  in   al,CDATA                                     { hi Byte into al }π  neg  al                                     { make it so counting up instead of down }πend;πππProcedure TreatFrame(Buffer:Pointer;Chunks:Word); Assembler;π{ this is the 'workhorse' routine that takes a frame and put it on the screen }π{ chunk by chunk }πLabelπ  Color_Loop, Copy_Bytes, Copy_Bytes2, Exit, Fli_Black, Fli_Brun, Fli_Color,π  Fli_Copy, Fli_Lc, Fli_Loop, Jump_Over, Line_Loop, Line_Loop2, Next_Line,π  Next_Line2, Pack_Loop, Pack_Loop2;πAsmπ  cli                                            { disable interrupts }π  push dsπ  push es                                        π  lds  si,Buffer                                 { let DS:SI point at the frame to be drawn }ππFli_Loop:                                        { main loop that goes through all the chunks in a frame }π  cmp  Chunks,0                                  { are there any more chunks to draw? }π  je   Exitπ  dec  Chunks                                    { decrement Chunks For the chunk to process now }ππ  mov  ax,[Word ptr ds:si+4]                     { let AX have the ChunkType }π  add  si,6                                      { skip the ChunkHeader }ππ  cmp  ax,0Bh                                    { is it a FLI_COLor chunk? }π  je   Fli_Colorπ  cmp  ax,0Ch                                    { is it a FLI_LC chunk? }π  je   Fli_Lcπ  cmp  ax,0Dh                                    { is it a FLI_BLACK chunk? }π  je   Fli_Blackπ  cmp  ax,0Fh                                    { is it a FLI_BRUN chunk? }π  je   Fli_Brunπ  cmp  ax,10h                                    { is it a FLI_COPY chunk? }π  je   Fli_Copyπ  jmp  Fli_Loop                                  { This command should not be necessary since the Program should make one - }π                                                 { - of the other jumps }ππFli_Color:π  mov  bx,[Word ptr ds:si]                       { number of packets in this chunk (allways 1?) }π  add  si,2                                      { skip the NumberofPackets }π  mov  al,0                                      { start at color 0 }π  xor  cx,cx                                     { reset CX }ππColor_Loop:π  or   bx,bx                                     { set flags }π  jz   Fli_Loop                                  { Exit if no more packages }π  dec  bx                                        { decrement NumberofPackages For the package to process now }ππ  mov  cl,[Byte ptr ds:si+0]                     { first Byte in packet tells how many colors to skip }π  add  al,cl                                     { add the skiped colors to the start to get the new start }π  mov  dx,$3C8                                   { PEL Address Write Mode Register }π  out  dx,al                                     { tell the VGA card what color we start changing }ππ  inc  dx                                        { at the port abow the PEL_A_W_M_R is the PEL Data Register }π  mov  cl,[Byte ptr ds:si+1]                     { next Byte in packet tells how many colors to change }π  or   cl,cl                                     { set the flags }π  jnz  Jump_Over                                 { if NumberstoChange=0 then NumberstoChange=256 }π  inc  ch                                        { CH=1 and CL=0 => CX=256 }πJump_Over:π  add  al,cl                                     { update the color to start at }π  mov  di,cx                                     { since each color is made of 3 Bytes (Red, Green & Blue) we have to - }π  shl  cx,1                                      { - multiply CX (the data counter) With 3 }π  add  cx,di                                     { - CX = old_CX shl 1 + old_CX   (the fastest way to multiply With 3) }π  add  si,2                                      { skip the NumberstoSkip and NumberstoChange Bytes }π  rep  outsb                                     { put the color data to the VGA card FAST! }ππ  jmp  Color_Loop                                { finish With this packet - jump back }πππFli_Lc:π  mov  ax,0A000hπ  mov  es,ax                                     { let ES point at the screen segment }π  mov  di,[Word ptr ds:si+0]                     { put LinestoSkip into DI - }π  mov  ax,di                                     { - to get the offset address to this line we have to multiply With 320 - }π  shl  ax,8                                      { - DI = old_DI shl 8 + old_DI shl 6 - }π  shl  di,6                                      { - it is the same as DI = old_DI*256 + old_DI*64 = old_DI*320 - }π  add  di,ax                                     { - but this way is faster than a plain mul }π  mov  bx,[Word ptr ds:si+2]                     { put LinestoChange into BX }π  add  si,4                                      { skip the LinestoSkip and LinestoChange Words }π  xor  cx,cx                                     { reset cx }ππLine_Loop:π  or   bx,bx                                     { set flags }π  jz  Fli_Loop                                   { Exit if no more lines to change }π  dec  bxππ  mov  dl,[Byte ptr ds:si]                       { put PacketsInLine into DL }π  inc  si                                        { skip the PacketsInLine Byte }π  push di                                        { save the offset address of this line }ππPack_Loop:π  or   dl,dl                                     { set flags }π  jz   Next_Line                                 { Exit if no more packets in this line }π  dec  dlπ  mov  cl,[Byte ptr ds:si+0]                     { put BytestoSkip into CL }π  add  di,cx                                     { update the offset address }π  mov  cl,[Byte ptr ds:si+1]                     { put BytesofDatatoCome into CL }π  or   cl,cl                                     { set flags }π  jns  Copy_Bytes                                { no SIGN means that CL number of data is to come - }π                                                 { - else the next data should be put -CL number of times }π  mov  al,[Byte ptr ds:si+2]                     { put the Byte to be Repeated into AL }π  add  si,3                                      { skip the packet }π  neg  cl                                        { Repeat -CL times }π  rep  stosbπ  jmp  Pack_Loop                                 { finish With this packet }ππCopy_Bytes:                                      π  add  si,2                                      { skip the two count Bytes at the start of the packet }π  rep  movsbπ  jmp  Pack_Loop                                 { finish With this packet }ππNext_Line:π  pop  di                                        { restore the old offset address of the current line }π  add  di,320                                    { offset address to the next line }π  jmp  Line_LoopπππFli_Black:π  mov  ax,0A000hπ  mov  es,ax                                     { let ES:DI point to the start of the screen }π  xor  di,diπ  mov  cx,32000                                  { number of Words in a screen }π  xor  ax,ax                                     { color 0 is to be put on the screen }π  rep  stoswπ  jmp  Fli_Loop                                  { jump back to main loop }πππFli_Brun:π  mov  ax,0A000hπ  mov  es,ax                                     { let ES:DI point at the start of the screen }π  xor  di,diπ  mov  bx,200                                    { numbers of lines in a screen }π  xor  cx,cxππLine_Loop2:π  mov  dl,[Byte ptr ds:si]                       { put PacketsInLine into DL }π  inc  si                                        { skip the PacketsInLine Byte }π  push di                                        { save the offset address of this line }ππPack_Loop2:π  or   dl,dl                                     { set flags }π  jz   Next_Line2                                { Exit if no more packets in this line }π  dec  dlπ  mov  cl,[Byte ptr ds:si]                       { put BytesofDatatoCome into CL }π  or   cl,cl                                     { set flags }π  js   Copy_Bytes2                               { SIGN meens that CL number of data is to come - }π                                                 { - else the next data should be put -CL number of times }π  mov  al,[Byte ptr ds:si+1]                     { put the Byte to be Repeated into AL }π  add  si,2                                      { skip the packet }π  rep  stosbπ  jmp  Pack_Loop2                                { finish With this packet }ππCopy_Bytes2:π  inc  si                                        { skip the count Byte at the start of the packet }π  neg  cl                                        { Repeat -CL times }π  rep  movsbπ  jmp  Pack_Loop2                                { finish With this packet }ππNext_Line2:π  pop  di                                        { restore the old offset address of the current line }π  add  di,320                                    { offset address to the next line }π  dec  bx                                        { any more lines to draw? }π  jnz  Line_Loop2π  jmp  Fli_Loop                                  { jump back to main loop }πππFli_Copy:π  mov  ax,0A000hπ  mov  es,ax                                     { let ES:DI point to the start of the screen }π  xor  di,diπ  mov  cx,32000                                  { number of Words in a screen }π  rep  movswπ  jmp  Fli_Loop                                  { jump back to main loop }πππExit:π  sti                                            { enable interrupts }π  pop  esπ  pop  dsπend;ππππbeginπ  WriteLn;π  WriteLn('.FLI-Player v1.1 by Thaco');π  WriteLn('  (c) EPOS, August 1992');π  WriteLn;π  if ParamCount=0 then                           { if no input parameters then Write the 'usage Text' }π  beginπ    WriteLn('USAGE: FLIPLAY <options> <Filename>');π    WriteLn('                   '+#24+'         '+#24);π    WriteLn('                   │         └──  Filename of .FLI File');π    WriteLn('                   └────────────  -d   = Do not use XMS');π    WriteLn('                                  -i   = InFormation about the Program');π    WriteLn('                                  -n   = No checking of MCGA mode support');π    WriteLn('                                  -sNN = Set playspeed to NN video ticks (0-99)');π    WriteLn('                                         ( NN=70 ≈ frame Delay of 1 second )');π    Halt(0);π  end;ππ  For Counter:=1 to ParamCount do                { search through the input parameters For a -Info option }π    if Pos('-I',UpCaseString(ParamStr(Counter)))<>0 thenπ    beginπ      WriteLn('Program inFormation:');π      WriteLn('This Program plays animations (sequences of pictures) made by Programs like',#10#13,π              'Autodesk Animator (so called .FLI-Files). The Program decodes the .FLI File,',#10#13,π              'frame by frame, and Uses the systemclock For mesuring the time-Delay between',#10#13,π              'each frame.');π      WriteLn('Basis For the Program was the FliLib package made by Jim Kent, but since the',#10#13,π              'original source was written in C, and I am not a good C-Writer, I decided',#10#13,π              'to Write my own .FLI-player in Turbo Pascal v6.0.');π      WriteLn('This Program was made by Eirik Milch Pedersen ([e-mail]).');π      WriteLn('Copyright Eirik Pedersens Own SoftwareCompany (EPOS), August 1992');π      WriteLn;π      WriteLn('Autodesk Animator is (c) Autodesk Inc');π      WriteLn('FliLib is (c) Dancing Flame');π      WriteLn('Turbo Pascal is (c) Borland International Inc');π      Halt(0);π    end;ππ  Speed:=-1;π  Counter:=1;π  While (Copy(ParamStr(Counter),1,1)='-') and (ParamCount>=Counter) do { search through the input parameters to assemble them }π  beginπ   if Pos('-D',UpCaseString(ParamStr(Counter)))<>0 then  { do not use XMS For storing the File into memory }π     UseXMS:=Falseπ   elseπ     if Pos('-N',UpCaseString(ParamStr(Counter)))<>0 then  { do not check For a vga card present }π       MCGACheck:=Falseπ     elseπ       if Pos('-S',UpCaseString(ParamStr(Counter)))<>0 then { speed override has been specified }π       beginπ         SpeedString:=Copy(ParamStr(Counter),3,2);  { cut out the NN parameter }π         if not(SpeedString[1] in ['0'..'9']) or    { check if the NN parameter is legal }π            (not(SpeedString[2] in ['0'..'9',' ']) and (Length(SpeedString)=2)) thenπ         beginπ           WriteLn('ERRor! Can not parse speed ''',SpeedString,'''.');π           Halt(0);π         end;π         Speed:=Byte(SpeedString[1])-48;  { take the first number, in ASCII, and convert it to a standard number }π         if Length(SpeedString)=2 then    { if there is two numbers then multiply the first With 10 and add the next }π           Speed:=Speed*10+Byte(SpeedString[2])-48;π         Speed:=Speed*CLOCK_SCALE;        { convert the speed to number of clock tics }π       end;π   Inc(Counter);π  end;ππ  if ParamCount<Counter thenπ  beginπ    WriteLn('ERRor! No Filename specified.');π    Halt(0);π  end;ππ  FileName:=UpCaseString(ParamStr(Counter));π  if Pos('.',FileName)=0 then  { find out if there exist a . in the Filename }π    FileName:=FileName+'.FLI'; { if not then add the .FLI extension on the Filename }ππ  if MaxAvail<BUFFERSIZE then   { check if there is enough memory to the frame buffer }π  beginπ    WriteLn('ERRor! Can not allocate enough memory to a frame buffer.');π    Halt(0);π  end;ππ  GetMem(Buffer,BUFFERSIZE);π  Assign(InputFile,FileName);π  Reset(InputFile,1);π  if Ioresult<>0 then  { has an error occured during opening the File? }π  beginπ    WriteLn('ERRor! Can not open File ''',FileName,'''.');π    Halt(0);π  end;ππ  if not(MCGACheck) or ModeSupport(MCGA) thenπ    InitMode(MCGA)π  elseπ  beginπ    WriteLn('ERRor! Video mode 013h - 320x200x256 colors - is not supported.');π    Halt(0);π  end;ππ  BlockRead(InputFile,Header,128);  { read the .FLI main header }ππ  if not((Header[4]=$11) and (Header[5]=$AF)) then  { check if the File has got the magic number }π  beginπ    InitMode(CO80);π    WriteLn('ERRor! File ''',FileName,''' is of a wrong File Type.');π    Halt(0);π  end;ππ  if NoXMS then  { if no XMS driver present then do not use XMS }π    UseXMS:=False;ππ  if UseXMS thenπ  beginπ    FileSize:=Header[0]+256*(LongInt(Header[1])+256*(LongInt(Header[2])+256*LongInt(Header[3])));π    if XMSMaxAvail<=(FileSize+1023) SHR 10 then  { is there enough XMS (rounded up to Nearest KB) availible? }π    beginπ      WriteLn('ERRor! not enough XMS For the File');π      Halt(0);π    endπ    elseπ    beginπ      Seek(InputFile,0);  { skip back to start of .FLI-File to put it all into XMS }π      BufferHandle:=XMSGetMem((FileSize+1023) SHR 10);  { allocate XMS For the whole .FLI File }π      FileCounter:=0;π      Repeatπ        BlockRead(InputFile,Buffer^,BUFFERSIZE,BytesRead);  { read a part from the .FLI File }π        if BytesRead MOD 2=1 then  { since BUFFERSIZE shoud be an even number, the only time this triggers is the last part }π          Inc(BytesRead);          { must be done because the XMS routine demands an even number of Bytes to be moved }π        if BytesRead<>0 thenπ        beginπ          With XMSRecord do  { put data into the XMSRecord }π          beginπ            BytestoMoveLo      :=BytesRead;π            BytestoMoveHi      :=0;π            SourceHandle       :=0;π            SourceoffsetLo     :=ofs(Buffer^);π            SourceoffsetHi     :=Seg(Buffer^);π            DestinationHandle  :=BufferHandle;π            DestinationoffsetLo:=FileCounter MOD 65536;π            DestinationoffsetHi:=FileCounter div 65536;π          end;π          XMSMove(XMSRecord);   { move Bytes to XMS }π          if XMSError<>0 then   { have any XMS errors occured? }π            ExitDuetoXMSError;π          Inc(FileCounter,BytesRead);  { update the offset into XMS where to put the next Bytes }π        end;π      Until BytesRead<>BUFFERSIZE;  { Repeat Until Bytes read <> Bytes tried to read => end of File }π    end;π    FileCounter:=128;  { we continue (after reading the .FLI File into XMS) right after the .FLI main header }π  end;ππ  Frames:=Header[6]+Header[7]*256;  { get the number of frames from the .FLI-header }π  if Speed=-1 then                  { if speed is not set by a speed override then get it from the .FLI-header }π    Speed:=(Header[16]+Integer(Header[17])*256)*CLOCK_SCALE;π  InitClock;  { initialize the System Clock }π  OldKey:=PorT[$60];  { get the current value from the keyboard }π  Key:=OldKey;        { and set the 'current key' Variable to the same value }ππ  GetBlock(Header,16);  { read the first frame-header }π  FrameSize:=Header[0]+256*(LongInt(Header[1])+256*(LongInt(Header[2])+256*LongInt(Header[3])))-16;  { calculate framesize }π  SecondPos:=128+16+FrameSize;  { calculate what position to skip to when the .FLI is finished and is going to start again - }π                                { the position = .FLI-header + first_frame-header + first_framesize }π  Chunks:=Header[6]+Header[7]*256;  { calculate number of chunks in frame }π  GetBlock(Buffer^,FrameSize);  { read the frame into the framebuffer }π  TreatFrame(Buffer,Chunks);  { treat the first frame }ππ  TimeCounter:=GetClock;  { get the current time }ππ  {π    The first frame must be handeled separatly from the rest. This is because the rest of the frames are updates/changes of theπ    first frame.π    At the end of the .FLI-File there is one extra frame who handles the changes from the last frame to the first frame.π  }ππ  Repeatπ    FrameNumber:=1;  { we start at the first frame (after the initial frame) }π    Repeatπ      GetBlock(Header,16);  { read frame-header }π      FrameSize:=Header[0]+256*(LongInt(Header[1])+256*(LongInt(Header[2])+256*LongInt(Header[3])))-16;  { size of frame }π      if FrameSize<>0 then  { sometimes there are no changes from one frame to the next (used For extra Delays). In such - }π                            { - Cases the size of the frame is 0 and we don't have to process them }π      beginπ        Chunks:=Header[6]+Header[7]*256;  { calculate number of chunks in the frame }π        GetBlock(Buffer^,FrameSize);  { read the frame into the framebuffer }π        TreatFrame(Buffer,Chunks);  { treat the frame }π      end;ππ      NextTime:=TimeCounter+Speed;   { calculate the Delay to the next frame }π      While TimeCounter<NextTime do  { wait For this long }π        TimeCounter:=GetClock;ππ      if PorT[$64]=KEYBOARD then   { check if the value at the keyboard port is caused by a key pressed }π        Key:=PorT[$60];            { get the current value from the keyboard }π      Inc(FrameNumber);  { one frame finished, over to the next one }π    Until (FrameNumber>Frames) or (Key<>OldKey);  { Repeated Until we come to the last frame or a key is pressed }ππ    if UseXMS thenπ      FileCounter:=SecondPosπ    elseπ      Seek(InputFile,SecondPos);  { set current position in the File to the second frame }ππ  Until Key<>OldKey;  { Exit the loop if a key has been pressed }ππ  InitMode(CO80);  { get back to Text mode }ππ  Close(InputFile);            { be a kind boy and close the File beFore we end the Program }π  FreeMem(Buffer,BUFFERSIZE);  { and free the framebuffer }ππ  if UseXMS thenπ    XMSFreeMem(BufferHandle);πEND.                                                                                                                          5      05-28-9313:51ALL                      SWAG SUPPORT TEAM        GLOBALS.PAS              IMPORT              146         Unit globals;ππ{ Use this Unit For Procedures, Functions and Variables that every Program youπ  Write will share.π}ππInterfaceππUses π  Dos;π  πTypeπ  str1 = String[1]; str2 = String[2]; str3 = String[3];π  str4 = String[4]; str5 = String[5]; str6 = String[6];π  str7 = String[7]; str8 = String[8]; str9 = String[9];π  str10 = String[10]; str11 = String[11]; str12 = String[12];π  str13 = String[13]; str14 = String[14]; str15 = String[15];π  str16 = String[16]; str17 = String[17]; str18 = String[18];π  str19 = String[19]; str20 = String[20]; str21 = String[21];π  str22 = String[22]; str23 = String[23]; str24 = String[24];π  str25 = String[25]; str26 = String[26]; str27 = String[27];π  str28 = String[28]; str29 = String[29]; str30 = String[30];π  str31 = String[31]; str32 = String[32]; str33 = String[33];π  str34 = String[34]; str35 = String[35]; str36 = String[36];π  str37 = String[37]; str38 = String[38]; str39 = String[39];π  str40 = String[40]; str41 = String[41]; str42 = String[42];π  str43 = String[43]; str44 = String[44]; str45 = String[45];π  str46 = String[46]; str47 = String[47]; str48 = String[48];π  str49 = String[49]; str50 = String[50]; str51 = String[51];π  str52 = String[52]; str53 = String[53]; str54 = String[54];π  str55 = String[55]; str56 = String[56]; str57 = String[57];π  str58 = String[58]; str59 = String[59]; str60 = String[60];π  str61 = String[61]; str62 = String[62]; str63 = String[63];π  str64 = String[64]; str65 = String[65]; str66 = String[66];π  str67 = String[67]; str68 = String[68]; str69 = String[69];π  str70 = String[70]; str71 = String[71]; str72 = String[72];π  str73 = String[73]; str74 = String[74]; str75 = String[75];π  str76 = String[76]; str77 = String[77]; str78 = String[78];π  str79 = String[79]; str80 = String[80]; str81 = String[81];π  str82 = String[82]; str83 = String[83]; str84 = String[84];π  str85 = String[85]; str86 = String[86]; str87 = String[87];π  str88 = String[88]; str89 = String[89]; str90 = String[90];π  str91 = String[91]; str92 = String[92]; str93 = String[93];π  str94 = String[94]; str95 = String[95]; str96 = String[96];π  str97 = String[97]; str98 = String[98]; str99 = String[99];π  str100 = String[100]; str101 = String[101]; str102 = String[102];π  str103 = String[103]; str104 = String[104]; str105 = String[105];π  str106 = String[106]; str107 = String[107]; str108 = String[108];π  str109 = String[109]; str110 = String[110]; str111 = String[111];π  str112 = String[112]; str113 = String[113]; str114 = String[114];π  str115 = String[115]; str116 = String[116]; str117 = String[117];π  str118 = String[118]; str119 = String[119]; str120 = String[120];π  str121 = String[121]; str122 = String[122]; str123 = String[123];π  str124 = String[124]; str125 = String[125]; str126 = String[126];π  str127 = String[127]; str128 = String[128]; str129 = String[129];π  str130 = String[130]; str131 = String[131]; str132 = String[132];π  str133 = String[133]; str134 = String[134]; str135 = String[135];π  str136 = String[136]; str137 = String[137]; str138 = String[138];π  str139 = String[139]; str140 = String[140]; str141 = String[141];π  str142 = String[142]; str143 = String[143]; str144 = String[144];π  str145 = String[145]; str146 = String[146]; str147 = String[147];π  str148 = String[148]; str149 = String[149]; str150 = String[150];π  str151 = String[151]; str152 = String[152]; str153 = String[153];π  str154 = String[154]; str155 = String[155]; str156 = String[156];π  str157 = String[157]; str158 = String[158]; str159 = String[159];π  str160 = String[160]; str161 = String[161]; str162 = String[162];π  str163 = String[163]; str164 = String[164]; str165 = String[165];π  str166 = String[166]; str167 = String[167]; str168 = String[168];π  str169 = String[169]; str170 = String[170]; str171 = String[171];π  str172 = String[172]; str173 = String[173]; str174 = String[174];π  str175 = String[175]; str176 = String[176]; str177 = String[177];π  str178 = String[178]; str179 = String[179]; str180 = String[180];π  str181 = String[181]; str182 = String[182]; str183 = String[183];π  str184 = String[184]; str185 = String[185]; str186 = String[186];π  str187 = String[187]; str188 = String[188]; str189 = String[189];π  str190 = String[190]; str191 = String[191]; str192 = String[192];π  str193 = String[193]; str194 = String[194]; str195 = String[195];π  str196 = String[196]; str197 = String[197]; str198 = String[198];π  str199 = String[199]; str200 = String[200]; str201 = String[201];π  str202 = String[202]; str203 = String[203]; str204 = String[204];π  str205 = String[205]; str206 = String[206]; str207 = String[207];π  str208 = String[208]; str209 = String[209]; str210 = String[210];π  str211 = String[211]; str212 = String[212]; str213 = String[213];π  str214 = String[214]; str215 = String[215]; str216 = String[216];π  str217 = String[217]; str218 = String[218]; str219 = String[219];π  str220 = String[220]; str221 = String[221]; str222 = String[222];π  str223 = String[223]; str224 = String[224]; str225 = String[225];π  str226 = String[226]; str227 = String[227]; str228 = String[228];π  str229 = String[229]; str230 = String[230]; str231 = String[231];π  str232 = String[232]; str233 = String[233]; str234 = String[234];π  str235 = String[235]; str236 = String[236]; str237 = String[237];π  str238 = String[238]; str239 = String[239]; str240 = String[240];π  str241 = String[241]; str242 = String[242]; str243 = String[243];π  str244 = String[244]; str245 = String[245]; str246 = String[246];π  str247 = String[247]; str248 = String[248]; str249 = String[249];π  str250 = String[250]; str251 = String[251]; str252 = String[252];π  str253 = String[253]; str254 = String[254]; str255 = String[255];ππConstπ  MaxWord    = $ffff;π  MinWord    = 0;π  MinInt     = Integer($8000);π  MinLongInt = $80000000;π  UseCfg     = True;ππ  {Color Constants:π   Black     = 0; Blue   = 1; Green   = 2; Cyan   = 3; Red   = 4;π   Magenta   = 5; Brown  = 6; LtGray  = 7;π   DkGray    = 8; LtBlue = 9; LtGreen = A; LtCyan = B; LtRed = C;π   LtMagenta = D; Yellow = E; White   = Fπ   }ππConst  Blink               = $80;ππ  {Screen color Constants}πConst   BlackOnBlack       = $00;          BlueOnBlack        = $01;πConst   BlackOnBlue        = $10;          BlueOnBlue         = $11;πConst   BlackOnGreen       = $20;          BlueOnGreen        = $21;πConst   BlackOnCyan        = $30;          BlueOnCyan         = $31;πConst   BlackOnRed         = $40;          BlueOnRed          = $41;πConst   BlackOnMagenta     = $50;          BlueOnMagenta      = $51;πConst   BlackOnBrown       = $60;          BlueOnBrown        = $61;πConst   BlackOnLtGray      = $70;          BlueOnLtGray       = $71;πConst   GreenOnBlack       = $02;          CyanOnBlack        = $03;πConst   GreenOnBlue        = $12;          CyanOnBlue         = $13;πConst   GreenOnGreen       = $22;          CyanOnGreen        = $23;πConst   GreenOnCyan        = $32;          CyanOnCyan         = $33;πConst   GreenOnRed         = $42;          CyanOnRed          = $43;πConst   GreenOnMagenta     = $52;          CyanOnMagenta      = $53;πConst   GreenOnBrown       = $62;          CyanOnBrown        = $63;πConst   GreenOnLtGray      = $72;          CyanOnLtGray       = $73;πConst   RedOnBlue          = $14;          MagentaOnBlue      = $15;πConst   RedOnGreen         = $24;          MagentaOnGreen     = $25;πConst   RedOnCyan          = $34;          MagentaOnCyan      = $35;πConst   RedOnRed           = $44;          MagentaOnRed       = $45;πConst   RedOnMagenta       = $54;          MagentaOnMagenta   = $55;πConst   RedOnBrown         = $64;          MagentaOnBrown     = $65;πConst   RedOnLtGray        = $74;          MagentaOnLtGray    = $75;πConst   BrownOnBlack       = $06;          LtGrayOnBlack      = $07;πConst   BrownOnBlue        = $16;          LtGrayOnBlue       = $17;πConst   BrownOnGreen       = $26;          LtGrayOnGreen      = $27;πConst   BrownOnCyan        = $36;          LtGrayOnCyan       = $37;πConst   BrownOnRed         = $46;          LtGrayOnRed        = $47;πConst   BrownOnMagenta     = $56;          LtGrayOnMagenta    = $57;πConst   BrownOnBrown       = $66;          LtGrayOnBrown      = $67;πConst   BrownOnLtGray      = $76;          LtGrayOnLtGray     = $77;πConst   DkGrayOnBlack      = $08;          LtBlueOnBlack      = $09;πConst   DkGrayOnBlue       = $18;          LtBlueOnBlue       = $19;πConst   DkGrayOnGreen      = $28;          LtBlueOnGreen      = $29;πConst   DkGrayOnCyan       = $38;          LtBlueOnCyan       = $39;πConst   DkGrayOnRed        = $48;          LtBlueOnRed        = $49;πConst   DkGrayOnMagenta    = $58;          LtBlueOnMagenta    = $59;πConst   DkGrayOnBrown      = $68;          LtBlueOnBrown      = $69;πConst   DkGrayOnLtGray     = $78;          LtBlueOnLtGray     = $79;πConst   LtGreenOnBlack     = $0A;          LtCyanOnBlack      = $0B;πConst   LtGreenOnBlue      = $1A;          LtCyanOnBlue       = $1B;πConst   LtGreenOnGreen     = $2A;          LtCyanOnGreen      = $2B;πConst   LtGreenOnCyan      = $3A;          LtCyanOnCyan       = $3B;πConst   LtGreenOnRed       = $4A;          LtCyanOnRed        = $4B;πConst   LtGreenOnMagenta   = $5A;          LtCyanOnMagenta    = $5B;πConst   LtGreenOnBrown     = $6A;          LtCyanOnBrown      = $6B;πConst   LtGreenOnLtGray    = $7A;          LtCyanOnLtGray     = $7B;πConst   LtRedOnBlue        = $1C;          LtMagentaOnBlue    = $1D;πConst   LtRedOnGreen       = $2C;          LtMagentaOnGreen   = $2D;πConst   LtRedOnCyan        = $3C;          LtMagentaOnCyan    = $3D;πConst   LtRedOnRed         = $4C;          LtMagentaOnRed     = $4D;πConst   LtRedOnMagenta     = $5C;          LtMagentaOnMagenta = $5D;πConst   LtRedOnBrown       = $6C;          LtMagentaOnBrown   = $6D;πConst   LtRedOnLtGray      = $7C;          LtMagentaOnLtGray  = $7D;πConst   YellowOnBlack      = $0E;          WhiteOnBlack       = $0F;πConst   YellowOnBlue       = $1E;          WhiteOnBlue        = $1F;πConst   YellowOnGreen      = $2E;          WhiteOnGreen       = $2F;πConst   YellowOnCyan       = $3E;          WhiteOnCyan        = $3F;πConst   YellowOnRed        = $4E;          WhiteOnRed         = $4F;πConst   YellowOnMagenta    = $5E;          WhiteOnMagenta     = $5F;πConst   YellowOnBrown      = $6E;          WhiteOnBrown       = $6F;πConst   YellowOnLtGray     = $7E;          WhiteOnLtGray      = $7F;πConst   BlackOnDkGray     = Blink + $00;   BlueOnDkGray      = Blink + $01;πConst   BlackOnLtBlue     = Blink + $10;   BlueOnLtBlue      = Blink + $11;πConst   BlackOnLtGreen    = Blink + $20;   BlueOnLtGreen     = Blink + $21;πConst   BlackOnLtCyan     = Blink + $30;   BlueOnLtCyan      = Blink + $31;πConst   BlackOnLtRed      = Blink + $40;   BlueOnLtRed       = Blink + $41;πConst   BlackOnLtMagenta  = Blink + $50;   BlueOnLtMagenta   = Blink + $51;πConst   BlackOnYellow     = Blink + $60;   BlueOnYellow      = Blink + $61;πConst   BlackOnWhite      = Blink + $70;   BlueOnWhite       = Blink + $71;πConst   GreenOnDkGray     = Blink + $02;   CyanOnDkGray      = Blink + $03;πConst   GreenOnLtBlue     = Blink + $12;   CyanOnLtBlue      = Blink + $13;πConst   GreenOnLtGreen    = Blink + $22;   CyanOnLtGreen     = Blink + $23;πConst   GreenOnLtCyan     = Blink + $32;   CyanOnLtCyan      = Blink + $33;πConst   GreenOnLtRed      = Blink + $42;   CyanOnLtRed       = Blink + $43;πConst   GreenOnLtMagenta  = Blink + $52;   CyanOnLtMagenta   = Blink + $53;πConst   GreenOnYellow     = Blink + $62;   CyanOnYellow      = Blink + $63;πConst   GreenOnWhite      = Blink + $72;   CyanOnWhite       = Blink + $73;πConst   RedOnDkGray       = Blink + $04;   MagentaOnDkGray   = Blink + $05;πConst   RedOnLtBlue       = Blink + $14;   MagentaOnLtBlue   = Blink + $15;πConst   RedOnLtGreen      = Blink + $24;   MagentaOnLtGreen  = Blink + $25;πConst   RedOnLtCyan       = Blink + $34;   MagentaOnLtCyan   = Blink + $35;πConst   RedOnLtRed        = Blink + $44;   MagentaOnLtRed    = Blink + $45;πConst   RedOnLtMagenta    = Blink + $54;   MagentaOnLtMagenta= Blink + $55;πConst   RedOnYellow       = Blink + $64;   MagentaOnYellow   = Blink + $65;πConst   RedOnWhite        = Blink + $74;   MagentaOnWhite    = Blink + $75;πConst   BrownOnDkGray     = Blink + $06;   LtGrayOnDkGray    = Blink + $07;πConst   BrownOnLtBlue     = Blink + $16;   LtGrayOnLtBlue    = Blink + $17;πConst   BrownOnLtGreen    = Blink + $26;   LtGrayOnLtGreen   = Blink + $27;πConst   BrownOnLtCyan     = Blink + $36;   LtGrayOnLtCyan    = Blink + $37;πConst   BrownOnLtRed      = Blink + $46;   LtGrayOnLtRed     = Blink + $47;πConst   BrownOnLtMagenta  = Blink + $56;   LtGrayOnLtMagenta = Blink + $57;πConst   BrownOnYellow     = Blink + $66;   LtGrayOnYellow    = Blink + $67;πConst   BrownOnWhite      = Blink + $76;   LtGrayOnWhite     = Blink + $77;πConst   DkGrayOnDkGray    = Blink + $08;   LtBlueOnDkGray    = Blink + $09;πConst   DkGrayOnLtBlue    = Blink + $18;   LtBlueOnLtBlue    = Blink + $19;πConst   DkGrayOnLtGreen   = Blink + $28;   LtBlueOnLtGreen   = Blink + $29;πConst   DkGrayOnLtCyan    = Blink + $38;   LtBlueOnLtCyan    = Blink + $39;πConst   DkGrayOnLtRed     = Blink + $48;   LtBlueOnLtRed     = Blink + $49;πConst   DkGrayOnLtMagenta = Blink + $58;   LtBlueOnLtMagenta = Blink + $59;πConst   DkGrayOnYellow    = Blink + $68;   LtBlueOnYellow    = Blink + $69;πConst   DkGrayOnWhite     = Blink + $78;   LtBlueOnWhite     = Blink + $79;πConst   LtGreenOnDkGray   = Blink + $0A;   LtCyanOnDkGray    = Blink + $0B;πConst   LtGreenOnLtBlue   = Blink + $1A;   LtCyanOnLtBlue    = Blink + $1B;πConst   LtGreenOnLtGreen  = Blink + $2A;   LtCyanOnLtGreen   = Blink + $2B;πConst   LtGreenOnLtCyan   = Blink + $3A;   LtCyanOnLtCyan    = Blink + $3B;πConst   LtGreenOnLtRed    = Blink + $4A;   LtCyanOnLtRed     = Blink + $4B;πConst   LtGreenOnLtMagenta= Blink + $5A;   LtCyanOnLtMagenta = Blink + $5B;πConst   LtGreenOnYellow   = Blink + $6A;   LtCyanOnYellow    = Blink + $6B;πConst   LtGreenOnWhite    = Blink + $7A;   LtCyanOnWhite     = Blink + $7B;πConst   LtRedOnDkGray     = Blink + $0C;   LtMagentaOnDkGray = Blink + $0D;πConst   LtRedOnLtBlue     = Blink + $1C;   LtMagentaOnLtBlue = Blink + $1D;πConst   LtRedOnLtGreen    = Blink + $2C;   LtMagentaOnLtGreen= Blink + $2D;πConst   LtRedOnLtCyan     = Blink + $3C;   LtMagentaOnLtCyan = Blink + $3D;πConst   LtRedOnLtRed      = Blink + $4C;   LtMagentaOnLtRed  = Blink + $4D;πConst   LtRedOnLtMagenta  = Blink + $5C;   LtMagentaOnLtMagenta= Blink + $5D;πConst   LtRedOnYellow     = Blink + $6C;   LtMagentaOnYellow = Blink + $6D;πConst   LtRedOnWhite      = Blink + $7C;   LtMagentaOnWhite  = Blink + $7D;πConst   YellowOnDkGray    = Blink + $0E;   WhiteOnDkGray     = Blink + $0F;πConst   YellowOnLtBlue    = Blink + $1E;   WhiteOnLtBlue     = Blink + $1F;πConst   YellowOnLtGreen   = Blink + $2E;   WhiteOnLtGreen    = Blink + $2F;πConst   YellowOnLtCyan    = Blink + $3E;   WhiteOnLtCyan     = Blink + $3F;πConst   YellowOnLtRed     = Blink + $4E;   WhiteOnLtRed      = Blink + $4F;πConst   YellowOnLtMagenta = Blink + $5E;   WhiteOnLtMagenta  = Blink + $5F;πConst   YellowOnYellow    = Blink + $6E;   WhiteOnYellow     = Blink + $6F;πConst   YellowOnWhite     = Blink + $7E;   WhiteOnWhite      = Blink + $7F;ππVarπ  TempStr    : String;π  TempStrLen : Byte Absolute TempStr;π  πFunction Exist(fn: str80): Boolean;π{ Returns True if File fn exists in the current directory                    }ππFunction ExistsOnPath(Var fn: str80): Boolean;π{ Returns True if File fn exists in any directory specified in the current   }π{ path and changes fn to a fully qualified path/File.                        }ππFunction StrUpCase(s : String): String;π{ Returns an upper Case String from s. Applicable to the English language.   }ππFunction StrLowCase(s : String): String;π{ Returns a String = to s With all upper Case Characters converted to lower  }ππFunction Asc2Str(Var s; max: Byte): String;π{ Converts an ASCIIZ String to a Turbo Pascal String With a maximum length   }π{ of max Characters.                                                         }ππProcedure Str2Asc(s: String; Var ascStr; max: Word);π{ Converts a TP String to an ASCIIZ String of no more than max length.       }π{ WARNinG:  No checks are made that there is sufficient room in destination  }π{           Variable.                                                        }ππFunction LastPos(ch: Char; s: String): Byte;π{ Returns the last position of ch in s                                       }ππProcedure CheckIO(a: Byte);ππImplementationππFunction Exist(fn: str80): Boolean;π  beginπ    TempStrLen := 0;π    TempStr    := FSearch(fn,'');π    Exist      := TempStrLen <> 0;π  end; { Exist }ππFunction ExistsOnPath(Var fn: str80): Boolean;π  beginπ    TempStrLen   := 0;π    TempStr      := FSearch(fn,GetEnv('PATH'));π    ExistsOnPath := TempStrLen <> 0;π    fn           := FExpand(TempStr);π  end; { ExistsOnPath }ππFunction StrUpCase(s : String): String;π  Var x : Byte;π  beginπ    StrUpCase[0] := s[0];π    For x := 1 to length(s) doπ      StrUpCase[x] := UpCase(s[x]);π  end; { StrUpCase }ππFunction StrLowCase(s : String): String;π  Var x : Byte;π  beginπ    StrLowCase[0] := s[0];π    For x := 1 to length(s) doπ      Case s[x] ofπ      'a'..'z': StrLowCase[x] := chr(ord(s[x]) and $df);π      else StrLowCase[x] := s[x];π      end; { Case }π  end; { StrLowCase }ππFunction Asc2Str(Var s; max: Byte): String;π  Var stArray  : Array[1..255] of Char Absolute s;π      len      : Integer;π  beginπ    len        := pos(#0,stArray)-1;                       { Get the length }π    if (len > max) or (len < 0) then               { length exceeds maximum }π      len      := max;                                  { so set to maximum }π    Asc2Str    := stArray;π    Asc2Str[0] := chr(len);                                    { Set length }π  end;  { Asc2Str }ππProcedure Str2Asc(s: String; Var ascStr; max: Word);π  beginπ    FillChar(AscStr,max,0);π    if length(s) < max thenπ      move(s[1],AscStr,length(s))π    elseπ      move(s[1],AscStr,max);π  end; { Str2Asc }πππFunction LastPos(ch: Char; s: String): Byte;π  Var x : Word;π  beginπ    x := succ(length(s));π    Repeatπ      dec(x);π    Until (s[x] = ch) or (x = 0);π  end; { LastPos }ππProcedure CheckIO(a: Byte);π  Var e : Integer;π  beginπ    e := Ioresult;π    if e <> 0 then beginπ      Writeln('I/O error ',e,' section ',a);π      halt(e);π    end;π  end; { CheckIO }ππend. { Globals }π  π                                                              6      05-28-9313:51ALL                      SWAG SUPPORT TEAM        HEBREW.PAS               IMPORT              118         {πDAVID SOLLYππFrom Israel Moshe Harel was heard to say to David SollyππThank you For taking the time to answer my many questions.  I have toπtell you, though, that I was lucky to have received your letter becauseπit was addressed to David SALLY and not David SOLLY.ππ>    Are you familiar With a Hebrew Text processor Program called QText?π> I have been able to obtain version 2.10 as public domain software but Iπ> am wondering if there has been an update.  Have you ever heard of aππMH>Current version of QText is 5.0 and it is commercial :-(π  >It comes now With a full set of utilities, including FAX support.ππDid you know that Q-Text version 2.10 was written in Turbo Pascal 3?  Iπwonder if Itschak Maynts (Isaac Mainz?) has continued to use it in hisπlater versions.  Anyway, I would be interested in obtaining the latestπversion of Q-Text.  Can you give me the distributor's address and theπapproximate price?  Thank you.ππ>Most Israeli Printers have a special ROM. You may use downloadable Characterπ>sets or even Graphic printing if needed. I once used LETTRIX For this purposπ>on a Hebrew-less Printer, and it worked fine (but S L O W . . .).πππI have Letrix 3.6.  This was what I was trying to use to print theπQ-Text Files I was writing.  I wrote a Program in Turbo Pascal toπconvert the Q-Text Files into Letrix Files.  The printing is slow butπthe results are favourable. Another advantage to Letrix Hebrew Files isπthat they are written completely in low-ASCII and almost readableπwithout transliteration if one is at all familiar With Hebrew. It is aπgood format For posting Hebrew Text on the Multi-Lingual echo not onlyπbecause it is low-ASCII but also because the method of transliterationπis consistent.ππBelow is my Q-Text File to Letrix File conversion Program.  I hope youπwill find it useful.π}ππProgram QTextLetrix;ππ{$D-}ππUsesπ  Crt, Dos;πππVarπ  InFile,π  TransFile   : Text;π  InFilenm,π  TransFilenm : PathStr;π  Letter, Ans : Char;π  Printable,π  Hebrew,π  Niqud,π  Roman       : Set of Char;π  Nkdm, Rom   : Boolean;ππ{π   "UpItsCase" is a Function that takes a sting of any length andπ   sets all of the Characters in the String to upper case.  It is handyπ   For comparing Strings.π}ππFunction UpItsCase (SourceStr : PathStr) : PathStr;πVarπ  i  : Integer;πbeginπ  For i := 1 to length(SourceStr) doπ    SourceStr[i] := UpCase(SourceStr[i]);π  UpItsCase := SourceStrπend; {Function UpItsCase}πππFunction Exist(fname : PathStr) : Boolean;πVarπ  f : File;πbeginπ{$F-,I-}π  Assign(f, fname);π  Reset(f);π  Close(f);π{$I+}π  Exist := (IOResult = 0) and (fname <> '')πend; {Function exist}ππProcedure Help;πbeginπ  Writeln;π  Writeln ('QTLT (Version 1.0)');π  Writeln ('Hebrew Text File Conversion');π  Writeln ('Q-Text 2.10 File to Letrix(R) 3.6 Hebrew File');π  Writeln;π  Writeln;π  Writeln ('QTLT converts Q-Text Files to Letrix Hebrew format Files.');π  Writeln;π  Writeln ('QTLT expects two parameters on the command line.');π  Writeln ('The first parameter is the name of the File to convert,');π  Writeln ('the second is the name of the new File.');π  Writeln;π  Writeln ('Example:  QTLT  HKVTL.HEB HKVTL.TXT');π  Writeln;π  Writeln ('If no parameters are found, QTLT will display this message.');π  Writeln;π  Halt;πend; {Procedure Help}ππ{π  "ParseCommandLine" is a Procedure that checks if any data was inputπ  at the Dos command line.  If no data is there, then the "Help"π  Procedure is executed and the Program is halted.  Otherwise, theπ  Mode strig Variable is set equal to the Text on the command line.π}ππProcedure ParseCommandLine;πbeginπ  if (ParamCount = 0) or (ParamCount <> 2) thenπ    Helpπ  elseπ  beginπ    InFilenm    := ParamStr(1);π    InFilenm    := UpItsCase(InFilenm);π    TransFilenm := ParamStr(2);π    TransFilenm := UpItsCase(TransFilenm);π  end;πend; {Procedure ParseCommandLine}ππProcedure OpenFiles;πbeginπ  {Open input/output Files}π  If not exist(InFilenm) thenπ  beginπ    Writeln;π    Writeln (InFilenm, ' not found');π    Halt;π  endπ  Elseπ  beginπ    Assign (InFile, InFilenm);π    Reset (InFile);π  end;ππ  If exist (TransFilenm) thenπ  beginπ    Writeln;π    Writeln (TransFilenm, ' already exists!');π    Write ('OverWrite it?  (Y/N) > ');π    Repeatπ      Ans := ReadKey;π      Ans := Upcase(Ans);π      If Ans = 'N' then Halt;π    Until Ans = 'Y';π  end;ππ  Assign (TransFile, TransFilenm);π  ReWrite (TransFile);π  Writeln;πend; {Procedure OpenFiles}ππππProcedure UseOfRoman;πbeginπ  Writeln ('QTLT has detected Roman letters in the source Text.');π  Writeln;π  Writeln ('Letrix expects access to a Roman font to print these Characters');π  Writeln ('otherwise Letrix will report an error condition of fail to perform.');π  Writeln;π  Writeln ('Sample Letrix load instruction:  LX Hebrew Roman');π  Writeln;π  Writeln ('Be sure that these instances are enclosed within the proper');π  Writeln ('Letrix font switch codes so they are not printed as Hebrew Character');π  Writeln;πend; {Procedure UseOfRoman}ππProcedure Niqudim (Var Letter : Char);π{π   Letrix Uses some standard Characters to represent niqudimπ   While Q-Text does not.ππ   This table ensures that certain Characters do not becomeπ   niqudim when translated to Letrix by inserting the tokensπ   which instruct the Letrix Program to use the alternateπ   alphabet -- which by default is number 2.π}πbeginπ  If Not Nkdm thenπ  beginπ    Writeln;π    Writeln ('QTLT has detected Q-Text Characters which Letrix normaly Uses for');π    Writeln ('has transcribed them to print as normal Characters.');π    Writeln;π    Writeln ('Letrix expects access a Roman font to print these Characters');π    Writeln ('otherwise Letrix will report an error condition of fail to perfect');π    Writeln;π    Writeln ('Sample Letrix load instruction:  LX Hebrew Roman');π    Writeln;π    Nkdm := True;π  end; {if not Nkdm}ππ  Case Letter ofππ    '!' : Write (TransFile, '\2!\1');π    '@' : Write (TransFile, '\2@\1');π    '#' : Write (TransFile, '\2#\1');π    '$' : Write (TransFile, '\2$\1');π    '%' : Write (TransFile, '\2%\1');π    '^' : Write (TransFile, '\2^\1');π    '&' : Write (TransFile, '\2&\1');π    '*' : Write (TransFile, '\2*\1');π    '(' : Write (TransFile, '\2(\1');π    ')' : Write (TransFile, '\2)\1');π    '+' : Write (TransFile, '\2+\1');π    '=' : Write (TransFile, '\2=\1');ππ  end; {Case}ππend; {Procedure Nikudim}ππππProcedure QT_Table (Var Letter : Char);π{π  This section reviews each QText letter and matches it With aπ  Letrix equivalent where possibleπ}πbeginπ  Case Letter ofππ    #128 : Write (TransFile, 'a');  {Alef}π    #129 : Write (TransFile, 'b');  {Bet }π    #130 : Write (TransFile, 'g');  {Gimmel etc. }π    #131 : Write (TransFile, 'd');π    #132 : Write (TransFile, 'h');π    #133 : Write (TransFile, 'w');π    #134 : Write (TransFile, 'z');π    #135 : Write (TransFile, 'H');π    #136 : Write (TransFile, 'T');π    #137 : Write (TransFile, 'y');π    #138 : Write (TransFile, 'C');π    #139 : Write (TransFile, 'c');π    #140 : Write (TransFile, 'l');π    #141 : Write (TransFile, 'M');π    #142 : Write (TransFile, 'm');π    #143 : Write (TransFile, 'N');π    #144 : Write (TransFile, 'n');π    #145 : Write (TransFile, 'S');π    #146 : Write (TransFile, 'i');π    #147 : Write (TransFile, 'F');π    #148 : Write (TransFile, 'p');π    #149 : Write (TransFile, 'X');π    #150 : Write (TransFile, 'x');π    #151 : Write (TransFile, 'k');π    #152 : Write (TransFile, 'r');π    #153 : Write (TransFile, 's');π    #154 : Write (TransFile, 't');ππ  end; {Case of}ππend; {Procedure QT_Table}πππProcedure DoIt;π{π  Special commands requred by Letrix.π  Proportional spacing off, line justification off,π  double-strike on, pitch set to 12 Characters per inch.π}πbeginππ  Writeln(transFile,'\p\j\D\#12');π  {Transcription loop}π  While not eof(InFile) doπ  beginπ    Read(InFile, Letter);ππ    If (Letter in Printable) thenπ      Write(TransFile, Letter);ππ    If (Letter in Niqud) thenπ      Niqudim(Letter);ππ    If (Letter in Hebrew) thenπ      QT_Table(Letter);ππ    If (Letter in Roman) and (Rom = False) thenπ    beginπ      UseOfRoman;π      Rom := True;π    end; {Roman Detection}ππ  end; {while}ππ  {Close Files}ππ  Close (TransFile);π  Close (InFile);ππ  {Final message}ππ  Writeln;π  Writeln;π  Writeln('QTLT (Version 1.0)');π  Writeln('Hebrew Text File Conversion');π  Writeln('Q-Text 2.10 Files to Letrix(R) 3.6 Hebrew File');π  Writeln;π  Writeln ('Task Complete');π  Writeln;π  Writeln ('QTLT was written and released to the public domain by David Solly');π  Writeln ('Bibliotheca Sagittarii, Ottawa, Canada (2 December 1992).');π  Writeln;ππend; {Procedure DoIt}πππbeginππ  {Initialize Variables}π  Printable := [#10,#12,#13,#32..#127];π  Roman     := ['A'..'Z','a'..'z'];π  Niqud     := ['!','@','#','$','%','^','&','*','(',')','+','='];π  Printable := Printable - Niqud;π  Hebrew    := [#128..#154];π  Rom       := False;π  Nkdm      := False;ππParseCommandLine;πOpenFiles;πDoIt;ππend.ππ{ππ   Please find below the Turbo Pascal source code For the conversionπProgram For making Letrix Hebrew Files into Q-Text 2.10 Files.  I couldπnot find a way to make this conversion Program convert embedded RomanπText without making it into a monster.  If you have any suggestions, Iπwould be thankful to the input.ππ========================= Cut Here ========================π}ππProgram LetrixQText;ππ{$D-}ππUsesπ  Crt, Dos;ππVarπ  InFile,π  TransFile   : Text;π  InFilenm,π  TransFilenm : PathStr;π  Letter, Ans : Char;π  Printable,π  HiASCII     : Set of Char;ππ{π  "UpItsCase" is a Function that takes a sting of any length andπ  sets all of the Characters in the String to upper case.  It is handyπ  For comparing Strings.π}ππFunction UpItsCase (SourceStr : PathStr): PathStr;πVarπ  i  : Integer;πbeginπ  For i := 1 to length(SourceStr) doπ    SourceStr[i] := UpCase(SourceStr[i]);π  UpItsCase := SourceStrπend; {Function UpItsCase}πππFunction Exist(fname : PathStr) : Boolean;πVarπ  f : File;πbeginπ  {$F-,I-}π  Assign(f, fname);π  Reset(f);π  Close(f);π  {$I+}π  Exist := (IOResult = 0) and (fname <> '')πend; {Function exist}ππProcedure Help;πbeginπ  Writeln;π  Writeln ('LTQT (Version 1.0)');π  Writeln ('Hebrew Text File Conversion');π  Writeln ('Letrix(R) 3.6 File to Q-Text 2.10 File');π  Writeln;π  Writeln;π  Writeln ('LTQT converts Letrix Hebrew format Files to  Q-Text format Files.')π  Writeln;π  Writeln ('LTQT expects two parameters on the command line.');π  Writeln ('The first parameter is the name of the File to convert,');π  Writeln ('the second is the name of the new File.');π  Writeln;π  Writeln ('Example:  LTQT  HKVTL.TXT HKVTL.HEB');π  Writeln;π  Writeln ('If no parameters are found, LTQT will display this message.');π  Writeln;π  Halt;πend; {Procedure Help}ππ{π  "ParseCommandLine" is a Procedure that checks if any data was inputπ  at the Dos command line.  If no data is there, then the "Help"π  Procedure is executed and the Program is halted.  Otherwise, theπ  Mode strig Variable is set equal to the Text on the command line.π}πProcedure ParseCommandLine;πbeginπ  if (ParamCount = 0) or (ParamCount <> 2) thenπ    Helpπ  elseπ  beginπ    InFilenm := ParamStr(1);π    InFilenm := UpItsCase(InFilenm);π    TransFilenm := ParamStr(2);π    TransFilenm := UpItsCase(TransFilenm);π  end;πend; {Procedure ParseCommandLine}ππProcedure OpenFiles;πbeginπ  {Open input/output Files}π  If not exist(InFilenm) thenπ  beginπ    Writeln;π    Writeln (InFilenm, ' not found');π    Halt;π  endπ  Elseπ  beginπ    Assign (InFile, InFilenm);π    Reset (InFile);π  end;ππ  If exist (TransFilenm) thenπ  beginπ    Writeln;π    Writeln (TransFilenm, ' already exists!');π    Write ('OverWrite it?  (Y/N) > ');π    Repeatπ      Ans := ReadKey;π      Ans := Upcase(Ans);π      If Ans = 'N' then Halt;π    Until Ans = 'Y';π  end;ππ  Assign (TransFile, TransFilenm);π  ReWrite (TransFile);π  Writeln;ππend; {Procedure OpenFiles}ππππProcedure LT_Table (Var Letter : Char);π{π  This section reviews each Letrix letter and matches it With aπ  Q-Text equivalent where possibleπ}πbeginπ  Case Letter ofππ    'a' : Write (TransFile, #128);π    'b', 'B','v' : Write (TransFile, #129);  {Vet, Bet}π    'g' : Write (TransFile, #130);π    'd' : Write (TransFile, #131);π    'h' : Write (TransFile, #132);π    'V', 'o', 'u', 'w' : Write (TransFile, #133); {Vav, Holem male, Shuruq}π    'z' : Write (TransFile, #134);π    'H' : Write (TransFile, #135);π    'T' : Write (TransFile, #136);π    'y', 'e' : Write (TransFile, #137); {Yod}π    'C', 'Q', 'W' : Write (TransFile, #138); {Khaf-Sofit}π    'c', 'K' : Write (TransFile, #139); {Khaf, Kaf}π    'l' : Write (TransFile, #140);π    'M' : Write (TransFile, #141);π    'm' : Write (TransFile, #142);π    'N' : Write (TransFile, #143);π    'n' : Write (TransFile, #144);π    'S' : Write (TransFile, #145);π    'i' : Write (TransFile, #146);π    'F' : Write (TransFile, #147);π    'p', 'P', 'f' : Write (TransFile, #148); {Fe, Pe}π    'X' : Write (TransFile, #149);π    'x' : Write (TransFile, #150);π    'k' : Write (TransFile, #151);π    'r' : Write (TransFile, #152);π    's' : Write (TransFile, #153);π    't' : Write (TransFile, #154);π    'A' : Write (TransFile, '-');ππ    {Niqudim and unused letters}ππ    'D','E', 'G', 'I', 'J', 'j', 'O', 'q', 'R', 'U', 'Y', 'Z' :π       Write(TransFile, '');π  elseπ    Write(TransFile, Letter);ππ  end; {Case of}ππend; {Procedure LT_Table}πππProcedure DoIt;πbeginπ  {Transcription loop}π  While not eof(InFile) doπ  beginπ    Read(InFile, Letter);ππ    If (Letter in Printable) thenπ      LT_Table(Letter);ππ    If (Letter in HiASCII) thenπ      Write(TransFile, Letter);π  end; {while}ππ  {Close Files}ππ  Close (TransFile);π  Close (InFile);ππ  {Final message}ππ  Writeln;π  Writeln;π  Writeln('LTQT Version 1.0');π  Writeln('Hebrew Text File Conversion');π  Writeln('Letrix(R) 3.6 File to Q-Text 2.10 File');π  Writeln;π  Writeln;π  Writeln ('Letrix Hebrew File to Q-Text File conversion complete.');π  Writeln;π  Writeln('Special Note:');π  Writeln;π  Writeln ('Q-Text does not support either dagesh or niqudim (vowels).');π  Writeln ('Letters containing a dagesh-qol are reduced to their simple form.');π  Writeln ('Holam male and shuruq are transcribed as vav.  Roman letters used');π  Writeln ('to represent niqudim are ignored.  All other symbols are transcribed'π  Writeln ('without change.');π  Writeln;π  Writeln ('There is no foreign language check -- Anything that can be transcribeπ  Writeln ('into Hebrew Characters will be.');π  Writeln;π  Writeln ('LTQT was written and released to the public domain by David Solly');π  Writeln ('Bibliotheca Sagittarii, Ottawa, Canada (8 December 1992).');π  Writeln;ππend; {Procedure DoIt}πππbeginπ  {Initialize Variables}π  Printable := [#10,#12,#13,#32..#127];π  HiASCII   := [#128..#154];ππ  ParseCommandLine;π  OpenFiles;π  DoIt;πend.ππ                                                                                                                            7      05-28-9313:51ALL                      SWAG SUPPORT TEAM        LONGJUMP.PAS             IMPORT              22          Unit LongJump;ππ{ This Unit permits a long jump from deeply nested Procedures/Functions back }π{ to a predetermined starting point.                                         }ππ{ Whilst the purists may shudder at such a practice there are times when such}π{ an ability can be exceedingly useful.  An example of such a time is in a   }π{ BBS Program when the carrier may be lost unexpectedly whilst a user is on  }π{ line and the requirement is to "back out" to the initialisation reoutines  }π{ at the start of the Program.                                               }ππ{ to use the facility, it is required that a call be made to the SetJump     }π{ Function at the point to where you wish the execution to resume after a    }π{ long jump. When the time comes to return to that point call FarJump.       }ππ{ if you are an inexperienced Programmer, I do not recommend that this Unit  }π{ be used For other than experimentation.  Usually there are better ways to  }π{ achieve what you want to do by proper planning and structuring.  It is     }π{ rare to find a well written Program that will need such and ability.       }ππInterfaceππConstπ  normal = -1;                         { return was not from a LongJump call }πTypeπ  jumpType = Record                        { the data need For a return jump }π                bp,sp,cs,ip : Word;π             end;ππFunction  SetJump(Var JumpData : jumpType): Integer;πProcedure FarJump(JumpData : jumpType; IDInfo : Integer);ππImplementationππTypeπ  WordPtr = ^Word;ππFunction SetJump(Var JumpData : jumpType): Integer;π  begin                     { store the return address (the old bp register) }π    JumpData.bp := WordPtr(ptr(SSeg,SPtr+2))^;π    JumpData.ip := WordPtr(ptr(SSeg,SPtr+4))^;π    JumpData.cs := WordPtr(ptr(SSeg,SPtr+6))^;π    JumpData.SP := SPtr;π    SetJump := normal;                { show that this is not a FarJump call }π  end;  { SetJump }ππProcedure FarJump(JumpData : jumpType; IDInfo : Integer );π  beginπ    { change the return address of the calling routine of the stack so that  }π    { a return can be made to the caller of SetJump                          }π    { Use IDInfo as an identifier of the routine the jump occurred from      }π    WordPtr(ptr(SSeg,JumpData.SP))^   := JumpData.bp;π    WordPtr(ptr(SSeg,JumpData.SP+2))^ := JumpData.ip;π    WordPtr(ptr(SSeg,JumpData.SP+4))^ := JumpData.cs;π    Inline($8b/$46/$06);                                     { mov ax,[bp+6] }π    Inline($8b/$ae/$fa/$ff);                                 { mov bp,[bp-6] }π  end;  { FarJump }ππend.  { LongJump }πππ                                                                                                               8      05-28-9313:51ALL                      SWAG SUPPORT TEAM        MAKEDATA.PAS             IMPORT              7           {> I need about 10 megs of raw data and am looking For info-pascal archives.π> Do they exist? ...and if so could someone please direct me to where I canπI wish everyone made such easy requests to fulfil. Try the followingπProgram. With minor changes, it will supply you With almost any amountπof data For which you could ask.π}πProgram GenerateData;πUsesπ  Crt;πConstπ  DataWanted = 3.0E5;πVarπ  Data    : File of Byte;π  Count   : LongInt;π  Garbage : Byte;πbeginπ  Assign(Data, 'Data.1MB');π  ReWrite(Data);π  Count   := 0;π  Garbage := 1;π  For Count := 1 to Round(DataWanted) doπ  beginπ    Write(Data, garbage); (* smile *)π    GotoXY(1,1);π    Write(Count);π    Inc(Count);π  end;π  Close(Data)πend.π                                                              9      05-28-9313:51ALL                      SWAG SUPPORT TEAM        MAZE.PAS                 IMPORT              14          {πSEAN PALMERππ> Hello there.. I was just wondering.. Since I am completely 'C'π> illiterate, could someone please make an effort and convert theπ> following code in Pascal For me? (Its supposedly makes a solveableπ> maze every time, Cool)ππ{originally by [e-mail]}π{Turbo Pascal conversion by Sean Palmer from original C}ππConstπ  h = 23; {height}π  w = 79; {width}ππConstπ  b : Array [0..3] of Integer = (-w, w, 1, -1);π  { incs For up, down, right, left }ππVarπ  a : Array [0..w * h - 1] of Boolean;  { the maze (False = wall) }ππProcedure m(p : Integer);πVarπ  i, d : Byte;πbeginπ  a[p] := True;           {make a path}π  Repeatπ    d := 0;               {check For allowable directions}π    if (p > 2 * w) and not (a[p - w - w]) thenπ      inc(d, 1);          {up}π    if (p < w * (h - 2)) and not (a[p + w + w]) thenπ      inc(d, 2);          {down}π    if (p mod w <> w - 2) and not (a[p + 2]) thenπ      inc(d, 4);          {right}π    if (p mod w <> 1) and not (a[p - 2]) thenπ      inc(d, 8);          {left}π    if d <> 0 thenπ    beginπ      Repeat              {choose a direction that's legal}π        i := random(4);π      Until Boolean(d and(1 shl i));ππ     a[p + b[i]] := True; {make a path}π     m(p + 2 * b[i]);     {recurse}π    end;π  Until d = 0;            {Until stuck}πend;ππVarπ  i : Integer;ππbeginπ  randomize;π  fillChar(a, sizeof(a), False);π  m(succ(w));  {start at upper left}π  For i := 0 to pred(w * h) doπ  begin {draw}π    if i mod w = 0 thenπ      Writeln;π    if a[i] thenπ      Write(' ')π    elseπ      Write('█');π  end;πend.π                                                                                    10     05-28-9313:51ALL                      SWAG SUPPORT TEAM        MISCFUNC.PAS             IMPORT              52          Unit MiscFunc;ππ{ MiscFunc version 1.0 Scott D. Ramsay }ππ{   This is my misc. Function Unit.  Some of the Functions have      }π{ nothing to do With games design but, my Units use it so ...        }π{   MiscFunc.pas is free.  Go crazy.                                 }π{   I've been writing comments to these Units all night.  Since you  }π{ have the source to this, I'll let you figure out what each one     }π{ does.   }ππInterfaceππFunction strint(s:String):LongInt;πFunction intstr(l:LongInt):String;πFunction ups(s:String):String;πFunction st(h:LongInt):String;πFunction Compare(s1,s2:String):Boolean;πFunction dtcmp(Var s1,s2;size:Word):Boolean;πFunction lz(i,w:LongInt):String;πFunction vl(h:String):LongInt;πFunction spaces(h:Integer):String;πFunction repstr(h:Integer;ch:Char):String;πFunction anything(s:String):Boolean;πFunction exist(f:String):Boolean;πFunction errmsg(n:Integer):String;πFunction turboerror(errorcode:Integer) : String;πProcedure funpad(Var s:String);πProcedure unpad(Var s:String);πProcedure munpad(Var s:String;b:Byte);πFunction fpad(s:String;h:Integer):String;πProcedure pad(Var s:String;h:Integer);πProcedure fix(Var s:String;h:String);πProcedure fixh(Var s:String);πFunction range(x,y,x1,y1,x2,y2:Integer) : Boolean;πFunction between(x,x1,x2:Integer):Boolean;ππImplementationπππFunction range(x,y,x1,y1,x2,y2:Integer) : Boolean;π{ returns True if (x,y) is in the rectangular region (x1,y1,x2,y2) }πbeginπ  range := ((x>=x1) and (x<=x2) and (y>=y1) and (y<=y2));πend;πππProcedure fix(Var s:String;h:String);πbeginπ  if pos('.',s)=0π    then s := s+h;πend;πππProcedure fixh(Var s:String);πVarπ  d : Integer;πbeginπ  For d := 1 to length(s) doπ    if s[d]<#32π      then s[d] := ' ';π  For d := length(s)+1 to 255 doπ    s[d] := ' ';πend;πππFunction strint(s:String):LongInt;πVarπ  l : LongInt;πbeginπ  move(s[1],l,sizeof(l));π  strint := l;πend;πππFunction intstr(l:LongInt):String;πVarπ  s : String;πbeginπ  move(l,s[1],sizeof(l));π  s[0] := #4;π  intstr := s;πend;πππFunction ups(s:String):String;πVarπ  d : Integer;πbeginπ  For d := 1 to length(s) doπ    s[d] := upCase(s[d]);π  ups := s;πend;πππFunction st(h:LongInt):String;πVarπ  s : String;πbeginπ  str(h,s);π  st := s;πend;πππFunction Compare(s1,s2:String):Boolean;πVarπ  d : Byte;π  e : Boolean;πbeginπ  e := True;π  For d := 1 to length(s1) doπ    if upCase(s1[d])<>upCase(s2[d])π      then e := False;π  Compare := e;πend;πππFunction dtcmp(Var s1,s2;size:Word):Boolean;πVarπ  d : Word;π  e : Boolean;πbeginπ  e := True;π  d := size;π  While (d>0) and e doπ    beginπ      dec(d);π      e := (mem[seg(s1):ofs(s1)+d]=mem[seg(s2):ofs(s2)+d]);π    end;π  dtcmp := e;πend;πππFunction lz(i,w:LongInt):String;πVarπ  d : LongInt;π  s : String;πbeginπ  str(i,s);π  For d := length(s) to w-1 doπ    s := concat('0',s);π  lz := s;πend;πππFunction vl(h:String):LongInt;πVarπ  d : LongInt;π  e : Integer;πbeginπ  val(h,d,e);π  vl := d;πend;πππFunction spaces(h:Integer):String;πVarπ  s : String;πbeginπ  s := '';π  While h>0 doπ    beginπ      dec(h);π      s := concat(s,' ');π    end;π  spaces := s;πend;πππFunction repstr(h:Integer;ch:Char):String;πVarπ  s : String;πbeginπ  s := '';π  While h>0 doπ    beginπ      dec(h);π      s := s+ch;π    end;π  repstr := s;πend;πππFunction anything(s:String):Boolean;πVarπ  d : Integer;π  h : Boolean;πbeginπ  if length(s)=0π    thenπ      beginπ        anything := False;π        Exit;π      end;π  h := False;π  For d := 1 to length(s) doπ    if s[d]>#32π      then h := True;π  anything := h;πend;πππFunction exist(f:String):Boolean;πVarπ  fil : File;πbeginπ  if f=''π    thenπ      beginπ        exist := False;π        Exit;π      end;π  assign(fil,f);π {$i- }π  reset(fil);π  close(fil);π {$i+ }π  exist := (ioresult=0);πend;πππFunction errmsg(n:Integer):String;πbeginπ   Case n ofπ      -1 : errmsg := '';π      -2 : errmsg := 'Error reading data File';π      -3 : errmsg := '';π      -4 : errmsg := 'equal current data File name';π     150 : errmsg := 'Disk is Write protected';π     152 : errmsg := 'Drive is not ready';π     156 : errmsg := 'Disk seek error';π     158 : errmsg := 'Sector not found';π     159 : errmsg := 'Out of Paper';π     160 : errmsg := 'Error writing to Printer';π    1000 : errmsg := 'Record too large';π    1001 : errmsg := 'Record too small';π    1002 : errmsg := 'Key too large';π    1003 : errmsg := 'Record size mismatch';π    1004 : errmsg := 'Key size mismatch';π    1005 : errmsg := 'Memory overflow';π     else errmsg := 'Error result #'+st(n);π   end;πend;πππFunction turboerror(errorcode:Integer) : String;πbeginπ  Case errorcode ofπ      1: turboerror := 'Invalid Dos Function code';π      2: turboerror := 'File not found';π      3: turboerror := 'Path not found';π      4: turboerror := 'too many open Files';π      5: turboerror := 'File access denied';π      6: turboerror := 'Invalid File handle';π      8: turboerror := 'not enough memory';π     12: turboerror := 'Invalid File access code';π     15: turboerror := 'Invalid drive number';π     16: turboerror := 'Cannot remove current directory';π     17: turboerror := 'Cannot rename across drives';π    100: turboerror := 'Disk read error';π    101: turboerror := 'Disk Write error';π    102: turboerror := 'File not assigned';π    103: turboerror := 'File not open';π    104: turboerror := 'File not open For input';π    105: turboerror := 'File not open For output';π    106: turboerror := 'Invalid numeric Format';π    200: turboerror := 'division by zero';π    201: turboerror := 'Range check error';π    202: turboerror := 'Stack overflow error';π    203: turboerror := 'Heap overflow error';π    204: turboerror := 'Invalid Pointer operation';π    else turboerror := errmsg(errorcode);π  end;πend;πππProcedure funpad(Var s:String);πbeginπ   While s[1]=' ' doπ      delete(s,1,1);πend;πππProcedure unpad(Var s:String);πbeginπ   While (length(s)>0) and (s[length(s)]<=' ') doπ      delete(s,length(s),1);πend;πππProcedure munpad(Var s:String;b:Byte);πbeginπ   s[0] := Char(b);π   While (length(s)>0) and (s[length(s)]<=' ') doπ      delete(s,length(s),1);πend;πππFunction fpad(s:String;h:Integer):String;πbeginπ   While length(s)<h doπ      s := concat(s,' ');π   fpad := s;πend;πππProcedure pad(Var s:String;h:Integer);πbeginπ   While length(s)<h doπ      s := concat(s,' ');πend;πππFunction between(x,x1,x2:Integer):Boolean;πbeginπ  between := ((x>=x1) and (x<=x2));πend;πππend.                                                                                                                   11     05-28-9313:51ALL                      SWAG SUPPORT TEAM        PATCHEXE.PAS             IMPORT              22          {π>If this cannot be done, then hhow can one include a pcx directly insideπ>the compiled File???ππ  There's a trick to do that :π  Suppose your Program is called PROG.EXE and your PCX File IMAGE.PCXππ  After each compile of PROG.EXE, do :π  COPY /B PROG.EXE+IMAGE.PCXππ  Then, when you want to display the PCX, open the EXE File, read it'sπ  header :π}ππFunction GetExeSize(ExeName:String; Var TotSize,Expect:LongInt):Boolean;π{ returns True if EXE is already bind }πTypeπ  ExeHeaderRec = Record {Information describing EXE File}π    Signature         : Word; {EXE File signature}π    LengthRem         : Word; {Number of Bytes in last page of EXE imageπ    LengthPages       : Word; {Number of 512 Byte pages in EXE image}π    NumReloc          : Word; {Number of relocation items}π    HeaderSize        : Word; {Number of paraGraphs in EXE header}π    MinHeap,MaxHeap   : Word; {ParaGraphs to keep beyond end of image}π    StackSeg,StackPtr : Word; {Initial SS:SP, StackSeg relative to imageπ    CheckSum          : Word; {EXE File check sum, not used}π    IpInit, CodeSeg   : Word; {Initial CS:IP, CodeSeg relative to imageπ    RelocOfs          : Word; {Bytes into EXE For first relocation item}π    OverlayNum        : Word; {Overlay number, not used here}π  end;ππVarπ  ExeF : File;π  ExeHeader : ExeHeaderRec;π  ExeValue : LongInt;π  count : Word;ππbeginπ  TotSize:=0; Expect:=0;π  Assign(ExeF,ExeName); Reset(ExeF,1);π  if IoResult=0 thenπ  beginπ    TotSize:=FileSize(ExeF);π    BlockRead(ExeF,ExeHeader,SizeOf(ExeHeaderRec),Count);π    With ExeHeader doπ    if Signature=$5A4D thenπ    beginπ      if LengthRem=0 thenπ        ExeValue:=LongInt(LengthPages) shl 9π      elseπ        ExeValue:=(LongInt(Pred(LengthPages)) shl 9)π      Expect:=ExeValue;π    end;π  end;π  Close(ExeF);π  GetExeSize:=(TotSize<>Expect);πend;ππ{π  If GetExeSize returns True, your PCX has been placed at the end of theπ  EXE (you did not forget :)) and all you have to do next is skip theπ  Program itself : Seek(ExeF,Expect);ππ  Then starts your PCX. If you know in advance the sizes of the PCXπ  File, you can place any data you want (including lots of PCX) at theπ  end of your EXE.ππ  This example is taken from a Unit I wrote a long time ago (was calledπ  Caravane) and it worked very well. I accessed the end of my exe Fileπ  like a normal Typed File. Quite funny but I do not use this anymore.π  Note that you can LzExe or Pklite the EXE part (not the PCX one). Youπ  can DIET both parts With the resident version.ππ  I hope the Function GetExeSize is not copyrighted since it is much tooπ  commented to be one of my work :)π                                                                     12     05-28-9313:51ALL                      SWAG SUPPORT TEAM        REBOOT1.PAS              IMPORT              9           { Subject: How to reboot With TP7.0 ??? }πVarπ  hook : Word Absolute $0040:$0072;ππProcedure Reboot(Cold : Boolean); Far;πbeginπ  if (Cold = True) thenπ    hook := $0000π  elseπ    hook := $1234;ππ  ExitProc := ptr($FFFF,$0000);πend;πππ{πP.S.  Note that it does not require any Units to compile.  Thoughπdepending on your Implementation, you may need to call HALT toπtrip the Exit code (which caUses a reboot).π}ππProgram reset;πUsesπ  Dos;πVarπ  regs : Registers;πbeginπ  intr(25,regs);πend.ππ{ Yeah but it is easier to do it in Inline Asmπeg:π}πProgram reset;πbeginπ  Asmπ    INT 19h; {19h = 25 decimal}π    end;πend.ππ{πOne Word about this interupt is that it is the fastest rebootπI know of but some memory managers, eg QEMM 6.03 don't like it,πIt will seriously hang Windows if called from a Dos Shell,πMicrosoft Mouse Driver 8.20 doesn't seem to like being runπafter you call int 19h and it was resident.πOther than that it works like a gem!π}π                                                                             13     05-28-9313:51ALL                      SWAG SUPPORT TEAM        REBOOT2.PAS              IMPORT              7           {πKARIM SULTANππBelieve it or not,  Int 19h is not he way to go.  It will stimulate a warmπboot, but it is not very safe.  It doesn't do some of the shutdown workπnecessary For some applications, and the preferred method is to set the Wordπat location 40:72 and to jump to $FFFF:0.πHere are my Procedures For doing reboots from a Program:π}πProcedure ColdBoot;  Assembler;πAsmπ  Xor  AX, AXπ  Mov  ES, AXπ  Mov  Word PTR ES:[472h],0000h   {This is not a WARM boot}π  Mov  AX, 0F000hπ  Push AXπ  Mov  AX, 0FFF0hπ  Push AXπ  Retfπend;ππProcedure WarmBoot;  Assembler;πAsmπ  Xor  AX, AXπ  Mov  ES, AXπ  Mov  Word PTR ES:[472h],1234h   {This is not a COLD boot}π  Mov  AX, 0F000hπ  Push AXπ  Mov  AX, 0FFF0hπ  Push AXπ  Retfπend;π                                          14     05-28-9313:51ALL                      SWAG SUPPORT TEAM        REBOOT3.PAS              IMPORT              4           {πREYNIR STEFANSSONππFor anyone wondering how to reboot a PClone from Within Turbo Pascal:πThe Inline code is a far jump to the restart vector at $FFFF:0.π}ππProcedure ColdStart;πbeginπ   MemW[$40:$72] := 0;π   Inline($EA/0/0/$FF/$FF);πend;ππProcedure WarmStart;πbeginπ   MemW[$40:$72] := $1234;π   Inline($EA/0/0/$FF/$FF);πend;ππ                                                      15     05-28-9313:51ALL                      SWAG SUPPORT TEAM        SUNDRY.PAS               IMPORT              99          Unit sundry;ππInterfaceππUsesπ  Dos,π  sCrt,π  Strings;ππTypeπ  LongWds = Recordπ              loWord,π              hiWord : Word;π            end;π  ica_rec = Recordπ              Case Integer ofπ                0: (Bytes   : Array[0..15] of Byte);π                1: (Words   : Array[0..7] of Word);π                2: (Integers: Array[0..7] of Integer);π                3: (strg    : String[15]);π                4: (longs   : Array[0..3] of LongInt);π                5: (dummy   : String[13]; chksum: Integer);π                6: (mix     : Byte; wds : Word; lng : LongInt);π            end;π{-This simply creates a Variant Record which is mapped to 0000:04F0π  which is the intra-applications communications area in the bios areaπ  of memory. A Program may make use of any of the 16 Bytes in this areaπ  and be assured that Dos and the bios will not interfere With it. Thisπ  means that it can be effectively used to pass values/inFormationπ  between different Programs. It can conceivably be used to storeπ  inFormation from an application, then terminate from that application,π  run several other Programs, and then have another Program use theπ  stored inFormation. As the area can be used by any Program, it is wiseπ  to incorporate a checksum to ensure that the intermediate applicationsπ  have not altered any values. It is of most use when executing childπ  processes or passing values between related Programs that are runπ  consecutively.}ππ  IOproc = Procedure(derror:Byte; msg : String);ππConstπ  ValidChars : String[40] = ' ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-'+#39;π  HexChars : Array[0..15] of Char = '0123456789ABCDEF';ππVarπ  ica : ica_rec Absolute $0000:$04f0;π  FilePosition : LongInt;π(*  OldRecSize   : Word; *)π  TempStr      : String;ππProcedure CheckIO(Error_action : IOproc; msg : String);ππFunction CompressStr(Var n): String;π  {-Will Compress 3 alpha-numeric Bytes into 2 Bytes}ππFunction DeCompress(Var s): String;π  {-DeCompresses a String Compressed by CompressStr}ππFunction NumbofElements(Var s; size : Word): Word;π  {-returns the number of active elements in a set}ππFunction PrinterStatus : Byte;π  {-Gets the Printer status}ππFunction PrinterReady(Var b : Byte): Boolean;ππFunction TestBbit(n,b: Byte): Boolean;πFunction TestWbit(Var n; b: Byte): Boolean;πFunction TestLbit(n: LongInt; b: Byte): Boolean;ππProcedure SetBbit(Var n: Byte; b: Byte);πProcedure SetWbit(Var n; b: Byte);πProcedure SetLbit(Var n: LongInt; b: Byte);ππProcedure ResetBbit(Var n: Byte; b: Byte);πProcedure ResetWbit(Var n; b: Byte);πProcedure ResetLbit(Var n: LongInt; b: Byte);ππFunction right(Var s; n : Byte): String;πFunction left(Var s; n : Byte): String;πFunction shleft(Var s; n : Byte): String;πFunction nExtStr(Var s1; s2 : String; n : Byte): String;πProcedure WriteAtCr(st: String; col,row: Byte);πProcedure WriteLnAtCr(st: String; col,row: Byte);πProcedure WriteLNCenter(st: String; width: Byte);πProcedure WriteCenter(st: String; width: Byte);πProcedure GotoCR(col,row: Byte);ππ  {-These Functions and Procedures Unit provides the means to do randomπ    access reads on Text Files.  }ππFunction Exist(fn : String) : Boolean;ππFunction Asc2Str(Var s; max: Byte): String;ππProcedure DisableBlink(State:Boolean);ππFunction Byte2Hex(numb : Byte) : String;ππFunction Numb2Hex(Var numb) : String;ππFunction Long2Hex(long : LongInt): String;ππFunction Hex2Byte(HexStr : String) : Byte;ππFunction Hex2Word(HexStr : String) : Word;ππFunction Hex2Integer(HexStr : String) : Integer;ππFunction Hex2Long(HexStr : String) : LongInt;ππ{======================================================================}πππImplementationππProcedure CheckIO(error_action : IOproc;msg : String);π  Var c : Word;π  beginπ    c := Ioresult;π    if c <> 0 then error_action(c,msg);π  end;πππ{$F+}πProcedure ReportError(c : Byte; st : String);π  beginπ    Writeln('I/O Error ',c);π    Writeln(st);π    halt(c);π  end;π{$F-}ππFunction StUpCase(Str : String) : String;πVarπ  Count : Integer;πbeginπ  For Count := 1 to Length(Str) doπ    Str[Count] := UpCase(Str[Count]);π  StUpCase := Str;πend;ππππFunction CompressStr(Var n): String;π  Varπ    S      : String Absolute n;π    InStr  : String;π    len    : Byte Absolute InStr;π    Compstr: Recordπ              Case Byte ofπ                0: (Outlen  : Byte;π                    OutArray: Array[0..84] of Word);π                1: (Out     : String[170]);π             end;π    temp,π    x,π    count : Word;π  beginπ    FillChar(InStr,256,32);π    InStr := S;π    len   := (len + 2) div 3 * 3;π    FillChar(CompStr.Out,171,0);π    InStr := StUpCase(InStr);π    x := 1; count := 0;π    While x <= len do beginπ      temp  := pos(InStr[x+2],ValidChars);π      inc(temp,pos(InStr[x+1],ValidChars) * 40);π      inc(temp,pos(InStr[x],ValidChars) * 1600);π      inc(x,3);π      CompStr.OutArray[count] := temp;π      inc(count);π    end;π    CompStr.Outlen := count shl 1;π    CompressStr := CompStr.Out;π  end;  {-CompressStr}ππFunction DeCompress(Var s): String;π  Varπ    CompStr : Recordπ                clen : Byte;π                arry : Array[0..84] of Word;π              end Absolute s;π    x,π    count,π    temp    : Word;π  beginπ    With CompStr do beginπ      DeCompress[0] := Char((clen shr 1) * 3);π      x := 0; count := 1;π      While x <= clen shr 1 do beginπ        temp := arry[x] div 1600;π        dec(arry[x],temp*1600);π        DeCompress[count] := ValidChars[temp];π        temp := arry[x] div 40;π        dec(arry[x],temp*40);π        DeCompress[count+1] := ValidChars[temp];π        temp := arry[x];π        DeCompress[count+2] := ValidChars[temp];π        inc(count,3);π        inc(x);π      end;π    end;π  end;ππFunction NumbofElements(Var s; size : Word): Word;π {-The Variable s can be any set Type and size is the Sizeof(s)}π  Varπ    TheSet : Array[1..32] of Byte Absolute s;π    count,x,y : Word;π  beginπ    count := 0;π    For x := 1 to size doπ      For y := 0 to 7 doπ        inc(count, 1 and (TheSet[x] shr y));π    NumbofElements := count;π  end;ππFunction PrinterStatus : Byte;π   Var regs   : Registers; {-from the Dos Unit                         }π   beginπ     With regs do beginπ       dx := 0;            {-The Printer number   LPT2 = 1             }π       ax := $0200;        {-The Function code For service wanted      }π       intr($17,regs);     {-$17= ROM bios int to return Printer status}π       PrinterStatus := ah;{-Bit 0 set = timed out                     }π     end;                  {     1     = unused                        }π   end;                    {     2     = unused                        }π                           {     3     = I/O error                     }π                           {     4     = Printer selected              }π                           {     5     = out of paper                  }π                           {     6     = acknowledge                   }π                           {     7     = Printer not busy              }ππFunction PrinterReady(Var b : Byte): Boolean;π  beginπ    b := PrinterStatus;π    PrinterReady := (b = $90) {-This may Vary between Printers}π  end;ππFunction TestBbit(n,b: Byte): Boolean;π  beginπ    TestBbit := odd(n shr b);π  end;ππFunction TestWbit(Var n; b: Byte): Boolean;π  Var t: Word Absolute n;π  beginπ    if b < 16 thenπ      TestWbit := odd(t shr b);π  end;ππFunction TestLbit(n: LongInt; b: Byte): Boolean;π  beginπ    if b < 32 thenπ      TestLbit := odd(n shr b);π  end;ππProcedure SetBbit(Var n: Byte; b: Byte);π  beginπ    if b < 8 thenπ      n := n or (1 shl b);π  end;ππProcedure SetWbit(Var n; b: Byte);π  Var t : Word Absolute n; {-this allows either a Word or Integer}π  beginπ    if b < 16 thenπ      t := t or (1 shl b);π  end;ππProcedure SetLbit(Var n: LongInt; b: Byte);π  beginπ    if b < 32 thenπ      n := n or (LongInt(1) shl b);π  end;ππProcedure ResetBbit(Var n: Byte; b: Byte);π  beginπ    if b < 8 thenπ      n := n and not (1 shl b);π  end;ππProcedure ResetWbit(Var n; b: Byte);π  Var t: Word Absolute n;π  beginπ    if b < 16 thenπ      t := t and not (1 shl b);π  end;ππProcedure ResetLbit(Var n: LongInt; b: Byte);π  beginπ    if b < 32 thenπ      n := n and not (LongInt(1) shl b);π  end;ππFunction right(Var s; n : Byte): String;π  Varπ    st : String Absolute s;π    len: Byte Absolute s;π  beginπ    if n >= len then right := st elseπ    right := copy(st,len+1-n,n);π  end;ππFunction shleft(Var s; n : Byte): String;π  Varπ    st   : String Absolute s;π    stlen: Byte Absolute s;π    temp : String;π    len  : Byte Absolute temp;π  beginπ    if n < stlen then beginπ      move(st[n+1],temp[1],255);π      len := stlen - n;π      shleft := temp;π    end;π  end;ππFunction left(Var s; n : Byte): String;π  Varπ    st  : String Absolute s;π    temp: String;π    len : Byte Absolute temp;π  beginπ    temp := st;π    if n < len then len := n;π    left := temp;π  end;ππFunction nExtStr(Var s1;s2 : String; n : Byte): String;π  Varπ    main   : String Absolute s1;π    second : String Absolute s2;π    len    : Byte Absolute s2;π  beginπ    nExtStr := copy(main,pos(second,main)+len,n);π  end;ππProcedure WriteAtCr(st: String; col,row: Byte);π  beginπ    GotoXY(col,row);π    Write(st);π  end;πππProcedure WriteLnAtCr(st: String; col,row: Byte);π  beginπ    GotoXY(col,row);π    Writeln(st);π  end;ππFunction Charstr(ch : Char; by : Byte) : String;πVarπ  Str : String;π  Count : Integer;πbeginπ  Str := '';π  For Count := 1 to by doπ    Str := Str + ch;π  CharStr := Str;πend;πππProcedure WriteLnCenter(st: String; width: Byte);π  beginπ    TempStr := CharStr(' ',(width div 2) - succ((length(st) div 2)));π    st      := TempStr + st;π    Writeln(st);π  end;ππProcedure WriteCenter(st: String; width: Byte);π  beginπ    TempStr := CharStr(' ',(width div 2)-succ((length(st) div 2)));π    st      := TempStr + st;π    Write(st);π  end;ππProcedure GotoCR(col,row: Byte);π  beginπ    GotoXY(col,row);π  end;ππFunction Exist(fn : String): Boolean;π  Varπ    f         : File;π    OldMode   : Byte;π  beginπ    OldMode := FileMode;π    FileMode:= 0;π    assign(f,fn);π    {$I-}  reset(f,1); {$I+}π    if Ioresult = 0 then beginπ      close(f);π      Exist := True;π    endπ    elseπ      Exist := False;π    FileMode:= OldMode;π  end; {-Exist}ππFunction Asc2Str(Var s; max: Byte): String;π  Var stArray : Array[0..255] of Byte Absolute s;π      st      : String;π      len     : Byte Absolute st;π  beginπ    move(stArray[0],st[1],255);π    len := max;π    len := (max + Word(1)) * ord(pos(#0,st) = 0) + pos(#0,st)-1;π    Asc2Str := st;π  end;πππProcedure DisableBlink(state : Boolean);π   { DisableBlink(True) allows use of upper eight colors as background }π   { colours. DisableBlink(False) restores the normal mode and should  }π   { be called beFore Program Exit                                     }πVarπ   regs : Registers;πbeginπ  With regs doπ  beginπ    ax := $1003;π    bl := ord(not(state));π  end;π  intr($10,regs);πend;  { DisableBlink }ππFunction Byte2Hex(numb : Byte) : String;π  beginπ    Byte2Hex[0] := #2;π    Byte2Hex[1] := HexChars[numb shr  4];π    Byte2Hex[2] := HexChars[numb and 15];π  end;ππFunction Numb2Hex(Var numb) : String;π  { converts an Integer or a Word to a String. Using an unTypedπ    argument makes this possible. }π  Var n : Word Absolute numb;π  beginπ    Numb2Hex := Byte2Hex(hi(n))+Byte2Hex(lo(n));π  end;ππFunction Long2Hex(long : LongInt): String;π  beginπ    With LongWds(long) do { Type casting makes the split up easy}π      Long2Hex := Numb2Hex(hiWord) + Numb2Hex(loWord);π  end;ππFunction Hex2Byte(HexStr : String) : Byte;π  beginπ    Hex2Byte := pos(UpCase(HexStr[2]),HexChars)-1  +π               ((pos(UpCase(HexStr[1]),HexChars))-1) shl  4 { *  16}π  end;ππFunction Hex2Word(HexStr : String) : Word;π  { This requires that the String passed is a True hex String  of 4π    Chars and not in a Format like $FDE0 }π  beginπ    Hex2Word := pos(UpCase(HexStr[4]),HexChars)-1  +π               ((pos(UpCase(HexStr[3]),HexChars))-1) shl  4 + { *  16}π               ((pos(UpCase(HexStr[2]),HexChars))-1) shl  8 + { * 256}π               ((pos(UpCase(HexStr[1]),HexChars))-1) shl 12;  { *4096}π  end;ππFunction Hex2Integer(HexStr : String) : Integer;π  beginπ    Hex2Integer := Integer(Hex2Word(HexStr));π  end;ππFunction Hex2Long(HexStr : String) : LongInt;π  Var Long : LongWds;π  beginπ    Long.hiWord := Hex2Word(copy(HexStr,1,4));π    Long.loWord := Hex2Word(copy(HexStr,5,4));π    Hex2Long := LongInt(Long);π  end;ππbeginπ  FilePosition := 0;πend.π                                      16     05-28-9313:51ALL                      SWAG SUPPORT TEAM        TPASM.PAS                IMPORT              79          {  Ok here it is..   I have disasembled the following TP Program toπshow you the inner workings of TP (well at least 6.0).  TheπFolloing Program was Compiled in the IDE With RANGE, I/O, STACKπchecking turned off.  Look at the code close and see if you canπfind a nasty little bug in it beFore I show you the Asm that TPπCreated on disk.π}ππProgram TstFiles;ππType MyRec = Recordπ               LInt : LongInt;π               Hi   : Word;π               Lo   : Word;π               B1   : Byte;π               B2   : Byte;π               B3   : Byte;π               B4   : Byte;π             end;            {Record Size 12 Bytes}ππConst MaxRecs = 100;πππVar MyTypedFile   : File of MyRec;π    MyUnTypedFile : File;ππ    Rec           : MyRec;π    RecCnt        : Word;πππProcedure FillRec (RecSeed : LongInt);ππ  beginπ  Rec.Lint := RecSeed;π  Rec.Hi   := Hi (Rec.Lint);π  Rec.Lo   := Lo (Rec.Lint);π  Rec.B1   := Lo (Rec.Lo);π  Rec.B2   := Hi (Rec.Lo);π  Rec.B3   := Lo (Rec.Hi);π  Rec.B4   := Hi (Rec.Hi);π  end;πππππbeginπAssign  (MyTypedFile,   'Type.Dat');πAssign  (MyUnTypedFile, 'UnTyped.Dat');πReWrite (MyTypedFile);πReWrite (MyUnTypedFile);ππFor RecCnt := 1 to MaxRecs doπ  beginπ  FillRec (RecCnt);ππ  Write (MyTypedFile  , Rec);π{ Write (MyUnTypedFile, Rec);} {Illegal can't do this}ππ  FillRec (RecCnt + $FFFF);ππ{ BlockWrite (MyTypedFile, Rec, 1);} {Illegal Can't do this eather}ππ  BlockWrite (MyUnTypedFile, Rec, Sizeof (MyRec));π  end;πππend.πππThe Asm Break down is in the next two messages...ππTSTFileS.38: beginπ  cs:0051 9A0000262D     call   2D26:0000 <-------TP Start Up Codeπ  cs:0056 55             push   bpπ  cs:0057 89E5           mov    bp,spπTSTFileS.39: Assign (MyTypedFile, 'Type.Dat');π  cs:0059 BF4400         mov    di,0044π  cs:005C 1E             push   dsπ  cs:005D 57             push   diπ  cs:005E BF3C00         mov    di,003Cπ  cs:0061 0E             push   csπ  cs:0062 57             push   diπ  cs:0063 9AC004262D     call   2D26:04C0 <-------TP's Routine to setπ                                                  up File Records.πTSTFileS.40: Assign (MyUnTypedFile, 'UnTyped.Dat');π  cs:0068 BFC400         mov    di,00C4π  cs:006B 1E             push   dsπ  cs:006C 57             push   diπ  cs:006D BF4500         mov    di,0045π  cs:0070 0E             push   csπ  cs:0071 57             push   diπ  cs:0072 9AC004262D     call   2D26:04C0 <-------TP's Routine to setπ                                                  up File Records.πTSTFileS.41: ReWrite (MyTypedFile);π  cs:0077 BF4400         mov    di,0044π  cs:007A 1E             push   dsπ  cs:007B 57             push   diπ  cs:007C B80C00         mov    ax,000Cπ  cs:007F 50             push   axπ  cs:0080 9AF704262D     call   2D26:04F7 <-------TP's Routine toπ                                                  Create File.πTSTFileS.42: ReWrite (MyUnTypedFile);π  cs:0085 BFC400         mov    di,00C4π  cs:0088 1E             push   dsπ  cs:0089 57             push   diπ  cs:008A B88000         mov    ax,0080π  cs:008D 50             push   axπ  cs:008E 9AF704262D     call   2D26:04F7 <-------TP's Routine toπ                                                  Create File.πTSTFileS.44: For RecCnt := 1 to MaxRecs doπ  cs:0093 C70650010100   mov    Word ptr [TSTFileS.RECCNT],00π    ***  Clear the loop counter For first loopπ  cs:0099 EB04           jmp    TSTFileS.46 (009F)π    ***  Jump to the start of the Loopπ  cs:009B FF065001       inc    Word ptr [TSTFileS.RECCNT]π    ***  The Loop returns to here to inC the loop counterπTSTFileS.46:  FillRec (RecCnt);π  cs:009F A15001         mov    ax,[TSTFileS.RECCNT]π    ***  Move our RecCnt Var into AX registerπ  cs:00A2 31D2           xor    dx,dxπ    ***  Clear the DX Registerπ  cs:00A4 52             push   dxπ  cs:00A5 50             push   axπ    ***  Push the DX and AX Registers on the stack.  Remember ourπ         FillRec Routine expects a LongInt to be passed and RecCntπ         is only a Word.  So it Pushes the DX as the 0 Upper Wordπ         of the LongInt.π  cs:00A6 0E             push   csπ    ***  Push the code segment For some reasion.π  cs:00A7 E856FF         call   TSTFileS.FILLRECπ    ***  Call our FillRec RoutineπTSTFileS.48:  Write (MyTypedFile , Rec);π  cs:00AA BF4400         mov    di,0044π  cs:00AD 1E             push   dsπ  cs:00AE 57             push   diπ    ***  These instructions push the address of MyTypedFile Recordπ         on the stack.  The first paramiterπ  cs:00AF BF4401         mov    di,0144π  cs:00B2 1E             push   dsπ  cs:00B3 57             push   diπ    ***  These instructions push the address of Rec Recordπ         on the stack.  The second paramiterπ  cs:00B4 9AAA05262D     call   2D26:05AAπ    ***  Call the System Function to Write a Typed File.  (In next msg)π  cs:00B9 83C404         add    sp,0004π    ***  Remove our passed parameters from the stackπTSTFileS.51:  FillRec (RecCnt + $FFFF);π  cs:00BC A15001         mov    ax,[TSTFileS.RECCNT]π  cs:00BF 05FFFF         add    ax,FFFFπ  cs:00C2 31D2           xor    dx,dxπ  cs:00C4 52             push   dxπ  cs:00C5 50             push   axπ  cs:00C6 0E             push   csπ  cs:00C7 E836FF         call   TSTFileS.FILLRECπ    ***  Now heres a NASTY littel bug With the code!!!  Look at theπ         above routine.  We wanted to pass a LongInt $FFFF + rec cntπ         But we wound up adding the $FFFF to a Word then passing aπ         LongInt.  if you Compile the sample pas File you'll be ableπ         to see this bug in action..  Good reasion to use a Debugger.πTSTFileS.55:  BlockWrite (MyUnTypedFile, Rec, Sizeof (MyRec))π  cs:00CA BFC400         mov    di,00C4π  cs:00CD 1E             push   dsπ  cs:00CE 57             push   diπ    ***  These instructions push the address of MyUnTypeFile Recordπ         on the stack.  The First paramiterπ  cs:00CF BF4401         mov    di,0144π  cs:00D2 1E             push   dsπ  cs:00D3 57             push   diπ  cs:0594 26817D02B3D7   cmp    es:Word ptr [di+02],D7B3π    *** Armed With the address of the File Record in ES:DIπ        Check the File mode For a In/Out operation.  See Dosπ        Unit Constant definitions.π  cs:059A 7406           je     05A2π    *** if that Compare was equal then jump to returnπ  cs:059C C7063C006700   mov    Word ptr [SYSTEM.inOUTRES],0069π    *** if we didn't jump then put File not oopen For output inπ        Ioresult.π  cs:05A2 C3             retπ    *** Go back to where we were calledπ  cs:05A3 B43F           mov    ah,3Fπ  cs:05A5 BA6400         mov    dx,0064π  cs:05A8 EB05           jmp    05AFππ    *** The Write instruction entered the system Unit hereπ  cs:05AA B440           mov    ah,40π    *** Load Dos Function in AHπ  cs:05AC BA6500         mov    dx,0065π    *** Default error code 101 disk Write error load in DXπ  cs:05AF 55             push   bpπ    ***  Save the BP registerπ  cs:05B0 8BEC           mov    bp,spπ    *** Load the BP Register With the stack Pointerπ  cs:05B2 C47E0A         les    di,[bp+0A]π    *** Load Address of MyTypeFile Rec in ES:SIπ  cs:05B5 E8DCFF         call   0594π    *** Call check For File mode.  See top of messageπ  cs:05B8 751B           jne    05D5π    *** if error jump out of thisπ  cs:05BA 1E             push   dsπ  cs:05BB 52             push   dxπ    *** Save These Registers as we'er going to use themπ  cs:05BC C55606         lds    dx,[bp+06]π    *** Load the address of our Rec in DS:DX Registersπ  cs:05BF 268B4D04       mov    cx,es:[di+04]π    *** Look up Record structure For a File Rec and you'll seeπ        that RecSize is Byte # 4.  Move that value to CXπ  cs:05C3 268B1D         mov    bx,es:[di]π    *** First Byte of a File Rec is the Handel.  Move into BXπ  cs:05C6 CD21           int    21π    *** Make the Dos CALL to Write.  AH = 40π                                     BX = File Handelπ                                     CX = # of Bytes to Write.π                                     DS:DX = Address of Bufferπ        Returns Error In AX if Carry flag set orπ        if good CF = 0 number of Bytes written in AXπ  cs:05C8 5A             pop    dxπ  cs:05C9 1F             pop    dsπ    *** Restore the Registersπ  cs:05CA 7206           jb     05D2π    *** Jump if there was an error (if Carry flag Set)π  cs:05CC 3BC1           cmp    ax,cxπ    *** Comp Bytes requested to what was writtenπ  cs:05CE 7405           je     05D5π    *** if equal then jump out we'r just about doneπ  cs:05D0 8BC2           mov    ax,dxπ    *** Move default errorcode 101 to AXπ  cs:05D2 A33C00         mov    [SYSTEM.inOUTRES],ax <--Set Ioresultπ    *** Store 101 to Ioresultπ  cs:05D5 5D             pop    bpπ    *** Restore BP registerπ  cs:05D6 CA0400         retf   0004π    *** We'r out of hereππ  cs:05D9 B33F           mov    bl,3Fπ  cs:05DB B96400         mov    cx,0064π  cs:05DE EB05           jmp    05E5πππ    *** The BlockWrite instruction entered the system Unit hereπ  cs:05E0 B340           mov    bl,40π    *** Move Dos Function in BLπ  cs:05E2 B96500         mov    cx,0065π    *** Default error 101 Write error in CXπ  cs:05E5 55             push   bpπ    *** Save BP Registerπ  cs:05E6 8BEC           mov    bp,spπ    *** Move Stack Pointer to BPπ  cs:05E8 C47E10         les    di,[bp+10]π    *** Load Address of MyUnTypedFile Record in ES:DIπ  cs:05EB E8A6FF         call   0594π    *** Check For Open in Write Mode See top of messageπ  cs:05EE 753F           jne    062Fπ    *** Jump if not in Write modeπ  cs:05F0 8B460A         mov    ax,[bp+0A] ]π    *** Move File Record cnt in to axπ  cs:05F3 0BC0           or     ax,axπ    *** Check For 0 Record requestπ  cs:05F5 741C           je     0613π    *** Jump if 0 rec requestedπ  cs:05F7 1E             push   dsπ  cs:05F8 51             push   cxπ    *** Save them we'er going to use themπ  cs:05F9 26F76504       mul    es:Word ptr [di+04]π    *** Multiply Record size With RecCnt in AX result in DX & AXπ  cs:05FD 8BC8           mov    cx,axπ               17     05-28-9313:51ALL                      SWAG SUPPORT TEAM        ZTRAS.PAS                IMPORT              33          Unit Globals;ππInterfaceππUses Crt{, Dos?};ππ{ Special keyboard Characters: }π{ I've squeezed them into a couple of lines so that they'd fit in aπmessage.. might be an idea to expand them back to ~20 lines or so..}ππ      NULL = #0;    BS = #8;    ForMFEED = #12;    CR = #13;    ESC = #27;ππ      HOMEKEY = #199;    {Values apply if only used With the 'Getkey' Function}π      endKEY = #207;      UPKEY = #200;      doWNKEY = #208;π      PGUPKEY = #201;     PGDNKEY = #209;    LEFTKEY = #203;π      inSKEY = #210;      RIGHTKEY = #205;   DELKEY = #211;π      CTRLLEFTKEY = #243; CTRLRIGHTKEY = #244;π      F1 = #187;    F2 = #188;    F3 = #189;    F4 = #190;    F5  = #191;π      F6 = #192;    F7 = #193;    F8 = #194;    F9 = #195;    F10 = #196;ππType  CurType       = ( off, Big, Small );ππVar   Ins           : Boolean;  { Global Var containing status of Insert key}ππ{-----------------------------------------------------------------------------}πFunction  GetKey : Char;πProcedure EdReadln(Var S : String);ππProcedure Cursor( Size : CurType ); { Either off, Big or Small }πProcedure ChangeCursor( Ins : Boolean );ππ{-----------------------------------------------------------------------------}πImplementationππFunction GetKey; { : Char; }ππVar C : Char;ππbeginπ  C := ReadKey;π  Repeatπ    if C = NULL thenπ    beginπ      C := ReadKey;π      if ord(C) > 127 thenπ        C := NULLπ      elseπ        GetKey := Chr(ord(C) + 128);π    end else GetKey := C;π  Until C <> NULL;πend; { GetKey }ππ{-----------------------------------------------------------------------------}πProcedure EdReadln; { (Var S : String); }ππ{ Legal : IString; MaxLength : Word; Var ESCPressed : Boolean); }ππVar CPos : Word;π    Ch   : Char;π    OldY : Byte;ππ    Legal      : String[1];π    MaxLength  : Byte;π    EscPressed : Boolean;ππbeginπ  OldY := WhereY - 1;π  ChangeCursor(Ins);π  CPos := 1;                {Place cursor at START of line}π{ CPos := Succ(Length(S));} {Whereas this places cursor at end of line}π  Legal := '';              {Legal and Maxlength originally passed as params}π  MaxLength := Lo( WindMax ) - Lo( WindMin );ππ  Repeatπ    Cursor( off );π    GotoXY(1, WhereY);π    Write(S, '':(MaxLength - Length(S)));π    GotoXY(CPos, WhereY);π    ChangeCursor(Ins);π    Ch := GetKey;π    Case Ch ofπ      HOMEKEY  : CPos := 1;π      endKEY   : CPos := Succ(Length(S));π      inSKEY   : beginπ                    Ins := not Ins;π                    ChangeCursor(Ins);π                 end;π      LEFTKEY  : if CPos > 1 then Dec(CPos);π      RIGHTKEY : if CPos <= Length(S) then Inc(CPos);π      BS       : if CPos > 1 thenπ                 beginπ                    Delete(S, Pred(CPos), 1);π                    Dec(CPos);π                 end;π      DELKEY   : if CPos <= Length(S) then Delete(S, CPos, 1);π      CR       : ;π      ESC      : beginπ                    S := '';π                    CPos := 1;π                 end;π      elseπ      beginπ        if ((Legal = '') or (Pos(Ch, Legal) <> 0)) andπ           ((Ch >= ' ') and (Ch <= '~')) andπ            (Length(S) < MaxLength) thenπ        beginπ          if Ins then Insert(Ch, S, CPos) elseπ          if CPos > Length(S) then S := S + Ch elseπ             S[CPos] := Ch;π          Inc(CPos);π        end;π      end;π    end; { Case }π  Until (Ch = CR);π  Cursor( Small );π  ESCPressed := Ch <> ESC;π  Writeln;πend; { EditString }ππ{-----------------------------------------------------------------------------}πProcedure Cursor; { ( Size : CurType ); { Either off, Big or Small }ππVar Regs : Registers;ππbeginπ   With Regs Do beginπ      Ax := $100;π      Case Size ofπ         off   : Cx := $3030;π         Big   : Cx := $0F;π         Small : Cx := $607;π      end;π      Intr ( $10, Regs );π   end;πend;ππ{-----------------------------------------------------------------------------}πProcedure ChangeCursor; { ( Ins : Boolean ); }π{Changes cursor size depending on status of insert key}ππbeginπ   if Ins then Cursor( Small ) else Cursor( Big );πend;ππbeginπend.π